ChatGPT와 엑셀을 바로 연동해서 사용하는 법, A-Z 완벽 정리!

Const APIKey As String = "API키" '<- API 키를 입력합니다.
Const APIUrl As String = "https://api.openai.com/v1/completions"
 
'---------------------------- ▼▼ 사용할 명령문을 이 안에 작성하세요 ▼▼ -------------------------------
'■xGPT_Run 함수
'xGPT_Run "입력셀주소", "출력셀주소", [List출력여부(True/False)]
'예) xGPT_Run "C6", "B8"
 
Sub MyGPT_Keyword()
 
xGPT_Run "C6", "B8", True
 
End Sub
 
Sub MyGPT_Report()
 
xGPT_Run "C16", "B18", False
 
End Sub
 
'---------------------------- ▲▲ 사용할 명령문을 이 안에 작성하세요 ▲▲ -------------------------------
 
Function xGPT(sRequest, Optional Temperature As Double = 0, Optional Max_Tokens As Integer = 0)
 
'■ GPT 모델 설명은 아래 링크를 참고하세요.
'https://platform.openai.com/docs/models/gpt-3
'■ 비용에 대한 설명은 아래 링크를 참고하세요.
'https://openai.com/api/pricing/
'■ 비용 요약
'1000토큰 = 한글 450~500자 or 영어 750단어 or A4용지 절반 분량
'davinci는 최대 4000토큰 지원 ≒ 약 A2장 분량 입/출력 가능
'davinci 모델(가장 좋은 성능) : 1000토큰 당 24원 (A4용지 한장 ≒ 50원)
'curie 모델(보편적 성능, 가성비 좋음) : 1000토큰당 2.4원 (A4용지 한장 ≒ 5원)
 
Application.EnableEvents = False
 
If sRequest = "" Then xGPT = "": Exit Function
 
Dim GPTModel As String: GPTModel = "text-davinci-003" '"text-davinci-003" '또는 "text-curie-001"
If Max_Tokens = 0 Then
If GPTModel = "text-curie-001" Then Max_Tokens = 1024
If GPTModel = "text-davinci-003" Then Max_Tokens = 2000
End If
Dim vHeader As Variant: ReDim vHeader(0 To 1)
vHeader(0) = Array("Content-Type", "application/json")
vHeader(1) = Array("Authorization", "Bearer " & APIKey)
Dim bodyJSON As String
Dim sResult As String
 
sRequest = Replace(Replace(Replace(Replace(sRequest, Chr(10), "\n"), Chr(13), "\n"), Chr(9), "\t"), """", "\""")
bodyJSON = "{"
bodyJSON = bodyJSON & """model"" : """ & GPTModel & """, "
bodyJSON = bodyJSON & """prompt"" : """ & sRequest & """, "
bodyJSON = bodyJSON & """temperature"" : " & Temperature & ", "
bodyJSON = bodyJSON & """max_tokens"" : " & Max_Tokens
bodyJSON = bodyJSON & "}"
 
sResult = GetHttp(APIUrl, bodyJSON, RequestHeader:=vHeader, RequestType:="POST").Body.innerHTML
sResult = Replace(sResult, """: """, """:""")
 
If InStr(1, sResult, """error"":") = 0 Then
sResult = ExtractJsonValue(sResult, "text")
'sResult = Splitter(sResult, "[{""text"":""", """,""")
 
Do While Left(sResult, 2) = "\n"
sResult = Right(sResult, Len(sResult) - 2)
Loop
 
sResult = Replace(Replace(sResult, "\n", vbNewLine), "\""", """")
 
xGPT = sResult
Else
 
sResult = ExtractJsonValue(sResult, "message")
xGPT = "#Error! : " & sResult
 
End If
 
Application.EnableEvents = True
 
End Function
 
Sub xGPT_Run(sPromptRange As String, sPrintRange As String, Optional isList As Boolean = True, Optional Temparature As Double = 0, Optional Max_Tokens As Integer = 2500)
 
Dim WS As Worksheet: Set WS = ActiveSheet
Dim PromptRange As Range: Set PromptRange = WS.Range(sPromptRange)
Dim PrintRange As Range: Set PrintRange = WS.Range(sPrintRange)
Dim vArrray As Variant
Dim ArrCount As Long
 
If isList = True Then
vArray = xGPT_List(PromptRange.Value, Temparature, Max_Tokens)
If PrintRange.Value <> "" Then PrintRange.CurrentRegion.ClearContents
PrintRange.Resize(UBound(vArray), 1) = vArray
Else
PrintRange.Value = xGPT(PromptRange.Value, Temparature, Max_Tokens)
End If
 
MsgBox "요청하신 작업이 완료되었습니다."
 
End Sub
 
Function xGPT_List(sRequest, Optional Temperature As Double = 0, Optional Max_Tokens As Integer = 2500)
 
Dim sResult As String
Dim vResult As Variant: Dim vReturn As Variant
Dim i As Long
 
sResult = xGPT(sRequest, Temperature)
vResult = Split(sResult, vbNewLine)
 
ReDim vReturn(1 To UBound(vResult) + 1, 1 To 1)
 
For i = LBound(vResult) To UBound(vResult)
vReturn(i + 1, 1) = Trim(vResult(i))
Next
 
xGPT_List = vReturn
 
End Function
 
Function ExtractJsonValue(s, v)
 
    Dim jsonString As String
    Dim regex As Object
    Dim matches As Object
 
    Set regex = CreateObject("VBScript.RegExp")
    s = Replace(s, "\""", "|||")
    regex.Pattern = """" & v & """:""(.*?)"","
    regex.Global = True
 
    Set matches = regex.Execute(s)
    If matches.Count > 0 Then ExtractJsonValue = Replace(matches.Item(0).SubMatches.Item(0), "|||", "\""")
 
End Function
 
Function GetHttp(URL As String, Optional formText As String, _
Optional isWinHttp As Boolean = False, _
Optional RequestHeader As Variant, _
Optional includeMeta As Boolean = False, _
Optional RequestType As String = "GET") As Object
 
'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'▶ GetHttp 함수
'▶ 웹에서 데이터를 받아옵니다.
'▶ 인수 설명
'_____________URL : 데이터를 스크랩할 웹 페이지 주소입니다.
'_____________formText : Encoding 된 FormText 형식으로 보내야 할 경우, Send String에 쿼리문을 추가합니다.
'_____________isWinHttp : WinHTTP 로 요청할지 여부입니다. Redirect가 필요할 경우 True로 입력하여 WinHttp 요청을 전송합니다.
'_____________RequestHeader : RequestHeader를 배열로 입력합니다. 반드시 짝수(한 쌍씩 이루어진) 개수로 입력되어야 합니다.
'_____________includeMeta : TRUE 일 경우 HTML 문서위로 ResponseText를 강제 입력합니다. Meta값이 포함되어 HTML이 작성되며 innerText를 사용할 수 없습니다. 기본값은 False 입니다.
'_____________RequestType : 요청방식입니다. 기본값은 "GET"입니다.
'▶ 사용 예제
'Dim HtmlResult As Object
'Set htmlResult = GetHttp("https://www.naver.com")
'msgbox htmlResult.body.innerHTML
'###############################################################
 
Dim oHTMLDoc As Object: Dim objHTTP As Object
Dim HTMLDoc As Object
Dim i As Long: Dim blnAgent As Boolean: blnAgent = False
Dim sUserAgent As String: sUserAgent = "Mozilla/5.0 (Linux; Android 6.0; Nexus 5 Build/MRA58N) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/86.0.4240.183 Mobile Safari/537.36"
 
Application.DisplayAlerts = False
 
If Left(URL, 4) <> "http" Then URL = "http://" & URL
 
Set oHTMLDoc = CreateObject("HtmlFile")
Set HTMLDoc = CreateObject("HtmlFile")
 
' 2023-02-22 | 수정 | 윈도우 인증 접속 문제 발생 시 (일부 버전) ServerXMLHTTP -> XMLHTTP 요청으로 변경
' XMLHTTP 요청 시, TimeOut 세팅 불가 (기본값 설정)
' https://stackoverflow.com/questions/11605613/differences-between-xmlhttp-and-serverxmlhttp
On Error GoTo SendError:
'------------------------------
If isWinHttp = False Then
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
Else
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
End If
 
objHTTP.setTimeouts 1200000, 1200000, 1200000, 1200000 '응답 대기시간 120초
 
' 2023-02-22 | 수정 | 윈도우 인증 접속 문제 발생 시 (일부 버전) ServerXMLHTTP -> XMLHTTP 요청으로 변경
SendRestart:
'------------------------------
objHTTP.Open RequestType, URL, False
If Not IsMissing(RequestHeader) Then
Dim vRequestHeader As Variant
For Each vRequestHeader In RequestHeader
Dim uHeader As Long: Dim Lheader As Long: Dim steps As Long
uHeader = UBound(vRequestHeader): Lheader = LBound(vRequestHeader)
If (uHeader - Lheader) Mod 2 = 0 Then GetHttp = CVErr(xlValue): Exit Function
For i = Lheader To uHeader Step 2
If vRequestHeader(i) = "User-Agent" Then blnAgent = True
objHTTP.setRequestHeader vRequestHeader(i), vRequestHeader(i + 1)
Next
Next
End If
If blnAgent = False Then objHTTP.setRequestHeader "User-Agent", sUserAgent
 
objHTTP.send formText
 
If includeMeta = False Then
With oHTMLDoc
.Open
.Write objHTTP.responseText
.Close
End With
Else
oHTMLDoc.Body.innerHTML = objHTTP.responseText
End If
 
Set GetHttp = oHTMLDoc
Set oHTMLDoc = Nothing
Set objHTTP = Nothing
 
Application.DisplayAlerts = True
 
' 2023-02-22 | 수정 | 윈도우 인증 접속 문제 발생 시 (일부 버전) ServerXMLHTTP -> XMLHTTP 요청으로 변경
Exit Function
 
SendError:
Set objHTTP = CreateObject("MSXML2.XMLHTTP")
On Error GoTo 0
Resume SendRestart:
'------------------------------
 
End Function
 
Function Splitter(v As Variant, Cutter As String, Optional Trimmer As String)
 
'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'▶ Splitter 함수
'▶ Cutter ~ Timmer 사이의 문자를 추출합니다. (Timmer가 빈칸일 경우 Cutter 이후 문자열을 추출합니다.)
'▶ 인수 설명
'_____________v : 문자열입니다.
'_________Cutter : 문자열 절삭을 시작할 텍스트입니다.
'_________Trimmer : 문자열 절삭을 종료할 텍스트입니다. (선택인수)
'▶ 사용 예제
'Dim s As String
's = "{sa;b132@drama#weekend;aabbcc"
's = Splitter(s, "@", "#")
'msgbox s '--> "drama"를 반환합니다.
'###############################################################
 
Dim vaArr As Variant
 
On Error GoTo EH:
 
vaArr = Split(v, Cutter)(1)
If Not IsMissing(Trimmer) Then vaArr = Split(vaArr, Trimmer)(0)
 
Splitter = vaArr
 
Exit Function
 
EH:
Splitter = ""
 
End Function
 
Function GoogleTranslate(OriginalText, _
Optional sFrom As String = "auto", _
Optional sTo As String = "") As String
 
'■변수 선언 및 할당
Dim strURL As String: Dim objHTTP As Object
Dim objHTML As Object: Dim objDivs As Object
Dim objDiv As Variant: Dim strResult As String
Dim vaRng As Variant: Dim Rng As Variant
 
Application.EnableEvents = False
 
If sTo = "" Then
If Application.LanguageSettings.LanguageID(msoLanguageIDUI) = 1042 Then sTo = "ko" Else sTo = "en"
End If
 
If TypeName(OriginalText) = "Range" Then
For Each vaRng In OriginalText
For Each Rng In vaRng
If Rng <> "" Then
strtext = strtext & Rng & vbNewLine
Else
strtext = strtext & vbNewLine
End If
Next
Next
Else
strtext = OriginalText
End If
 
'■ 구글 번역 API 요청
strtext = ENCODEURL(strtext)
strURL = "https://translate.google.com/m?hl=" & sFrom & _
"&sl=" & sFrom & _
"&tl=" & sTo & _
"&ie=UTF-8&prev=_m&q=" & strtext
 
On Error GoTo EH:
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
objHTTP.Open "GET", strURL, False
objHTTP.setRequestHeader "User-Agent", "Mozilla/5.0 (Linux; Android 6.0; Nexus 5 Build/MRA58N) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/86.0.4240.183 Mobile Safari/537.36"
objHTTP.send ""
 
strResult = objHTTP.responseText
 
'# 수정 | 2023-02-22 | 2016 이전 버전에서 Element 개체 반환 시 줄바꿈 -> 띄어쓰기로 변환되는 문제 확인되어 코드 수정
'■ 번역 결과 확인
If InStr(1, strResult, "Error 413") > 0 Then GoogleTranslate = "#Request Too Large!": Exit Function
strResult = Splitter(strResult, "<div class=""result-container"">", "</div><div class=""links-container"">")
 
'■ 결과값 출력
GoogleTranslate = Convert_Html_Entities(strResult)
 
Application.EnableEvents = True
Set objHTML = Nothing: Set objHTTP = Nothing
Exit Function
 
EH:
GoogleTranslate = "#TimeOut"
Application.EnableEvents = True
Set objHTML = Nothing: Set objHTTP = Nothing
End Function
 
Function Convert_Html_Entities(c)
 
c = Replace(c, "&quot;", """")
c = Replace(c, "&amp;", "&")
c = Replace(c, "&apos;", "'")
c = Replace(c, "&lt;", "<")
c = Replace(c, "&gt;", ">")
c = Replace(c, "&nbsp;", vbNewLine)
c = Replace(c, "&iexcl;", "¡")
c = Replace(c, "&cent;", "￠")
c = Replace(c, "&pound;", "￡")
c = Replace(c, "&curren;", "¤")
c = Replace(c, "&yen;", "￥")
c = Replace(c, "&brvbar;", "|")
c = Replace(c, "&sect;", "§")
c = Replace(c, "&uml;", "¨")
c = Replace(c, "&copy;", "ⓒ")
c = Replace(c, "&ordf;", "ª")
c = Replace(c, "&laquo;", "≪")
c = Replace(c, "&not;", "￢")
c = Replace(c, "&reg;", "®")
c = Replace(c, "&deg;", "°")
c = Replace(c, "&plusmn;", "±")
c = Replace(c, "&sup2;", "²")
c = Replace(c, "&sup3;", "³")
c = Replace(c, "&acute;", "´")
c = Replace(c, "&micro;", "μ")
c = Replace(c, "&para;", "¶")
c = Replace(c, "&middot;", "·")
c = Replace(c, "&cedil;", "¸")
c = Replace(c, "&sup1;", "¹")
c = Replace(c, "&ordm;", "º")
c = Replace(c, "&raquo;", "≫")
c = Replace(c, "&frac14;", "¼")
c = Replace(c, "&frac12;", "½")
c = Replace(c, "&frac34;", "¾")
c = Replace(c, "&iquest;", "¿")
c = Replace(c, "&times;", "×")
c = Replace(c, "&szlig;", "ß")
c = Replace(c, "&divide;", "÷")
c = Replace(c, "&yuml;", "y")
c = Replace(c, "&circ;", "^")
c = Replace(c, "&tilde;", "~")
c = Replace(c, "&mdash;", "-")
c = Replace(c, "&lsquo;", "'")
c = Replace(c, "&rsquo;", "'")
c = Replace(c, "&sbquo;", "'")
c = Replace(c, "&ldquo;", """")
c = Replace(c, "&rdquo;", """")
c = Replace(c, "&bdquo;", """")
c = Replace(c, "&dagger;", "†")
c = Replace(c, "&Dagger;", "‡")
c = Replace(c, "&hellip;", "…")
c = Replace(c, "&permil;", "‰")
c = Replace(c, "&lsaquo;", "?")
c = Replace(c, "&rsaquo;", "?")
c = Replace(c, "&euro;", "€")
c = Replace(c, "&trade;", "™")
c = Replace(c, "&rsquo;", "’")
c = Replace(c, "&laquo;", "≪")
c = Replace(c, "&raquo;", "≫")
c = Replace(c, "&cent;", "￠")
c = Replace(c, "&copy;", "ⓒ")
c = Replace(c, "&micro;", "μ")
c = Replace(c, "&pound;", "￡")
c = Replace(c, "&yen;", "￥")
c = Replace(c, "&yuml;", "y")
c = Replace(c, "&acute;", "´")
 
Convert_Html_Entities = c
 
End Function
 
Function ENCODEURL(varText As Variant, Optional blnEncode = True)
 
'###############################################################
'오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
'▶ EncodeURL 함수
'▶ 한글/영문, 특수기호가 포함된 문자열을 웹 URL 표준 주소로 변환합니다.
'▶ 인수 설명
'_____________varTest : 표준 URL 주소로 변환할 문자열입니다.
'_____________blnEncode : TRUE 일 경우 결과값을 출력합니다.
'▶ 사용 예제
's = "http://www.google.com/search=사과"
's = ENCODEURL(s)
'MsgBox s
'###############################################################
 
Static objHtmlfile As Object
 
If objHtmlfile Is Nothing Then
Set objHtmlfile = CreateObject("htmlfile")
With objHtmlfile.parentWindow
.execScript "function encode(s) {return encodeURIComponent(s)}", "jscript"
End With
End If
 
If blnEncode Then
ENCODEURL = objHtmlfile.parentWindow.encode(varText)
End If
 
End Function