엑셀 API 기초 3주 완성

=A1&A2

=A5&A3

=IMAGE(A6)

Function xIMAGE(Link, Optional Margin As Long = 0, Optional UpdateImage As Boolean = True) '############################################################### '오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com) '수정 및 배포 시 출처를 반드시 명시해야 합니다. '■ xIMAGE 함수 '■ 인터넷 URL 또는 특정 파일 경로의 이미지를 삽입합니다. '■ 사용방법 '=xImage("https://www.google.com/images/branding/googlelogo/1x/googlelogo_color_272x92dp.png") '■ 인수 설명 '_____________Link : 웹 URL 또는 파일 경로입니다. 웹 URL일 경우 링크는 반드시 https:// 또는 http:// 로 시작해야 합니다. '_____________Margin : 셀 안에 삽입할 그림에 여백을 줍니다. 픽셀 단위로 입력합니다. 기본값은 0(=여백없음)입니다. '_____________UpdateImage : TRUE 일 경우 기존 셀 안에 삽입되어 있던 그림을 삭제하고 새로운 그림으로 갱신합니다. 기본값은 TRUE 입니다. '############################################################### Dim aRng As Range: Dim aWS As Worksheet Dim shpImg As Shape On Error Resume Next Set aRng = Application.Caller Set aWS = aRng.Parent Application.EnableEvents = False If IsEmpty(Link) Then xIMAGE = CVErr(xlValue): Exit Function For Each shpImg In aWS.Shapes If shpImg.TopLeftCell.Address = aRng.Address Then If UpdateImage = True Then shpImg.Delete Else xIMAGE = True GoTo Final Exit Function End If End If Next Set shpImg = aWS.Shapes.AddPicture(Link, msoFalse, msoTrue, _ aRng.Left + Margin, aRng.Top + Margin, _ aRng.MergeArea.Width - Margin * 2, aRng.MergeArea.Height - Margin * 2) shpImg.Placement = xlMoveAndSize If shpImg Is Nothing Then xIMAGE = CVErr(xlValue) Else xIMAGE = True End If Final: Set shpImg = Nothing: Set aRng = Nothing: Set aWS = Nothing Application.EnableEvents = True End Function

=xIMAGE(A6)

Function GetKakaoAddress() '카카오 로컬 API 개발문서 'https://developers.kakao.com/docs/latest/ko/local/dev-guide '● 기본 변수 선언 Dim sAddress As String Dim sURL As String: Dim APIKey As String Dim vHeader As Variant: Dim sResult As String Dim vResult As Variant: ReDim vHeader(0 To 1) '● 변수 입력 '1. APIKey: 카카오 디벨로퍼 Rest API 키 'APIKey = "API키" '2. sAddress: 검색할 주소 'sAdddress = "서울시 구로구 구로동" '3. sURL: API로 요청할 URL 'sURL = "https://dapi.kakao.com/v2/local/search/address.json?query=" & ENCODEURL(sAddress) '4. vHeader: API 요청에 사용할 Request Header 'vHeader(0) = Array("Content-Type", "application/json") 'vHeader(1) = Array("Authorization", "KakaoAK " & APIKey) APIKey = "" sAddress = "" sURL = "" vHeader(0) = Array("Content-Type", "application/json") vHeader(1) = Array("Authorization", "KakaoAK " & APIKey) '● HTTP 요청 및 결과 받아오기 'GetHTTP 함수를 사용합니다. '사용예제: 'sResult = GetHttp(sURL,RequestHeader:=vHeader).Body.InnerHtml 'MsgBox sResult '● 주소 추출 후 배열로 출력하기 '미리 완성해드린 GetAddress 예제 코드를 사용합니다. 'vResult = GetAddress(sResult) 'GetKakaoAddress = vResult End Function Function GetAddress(sResult) '############################################################### 'API 기초 챌린지 강의용 VBA 코드입니다. '▶ GetAddress 함수 '▶ 카카오 로컬 API 결과값에서 지번주소/도로명주소(첫번째 항목)을 배열로 반환합니다. '############################################################### Dim sOldAddress As String: Dim vOldAddress As Variant: Dim OldCount As Long Dim sNewAddress As String: Dim vNewAddress As Variant: Dim NewCount As Long Dim vResult As Variant Dim i As Long On Error Resume Next sOldAddress = Splitter(sResult, """address"":{", "}") sNewAddress = Splitter(sResult, """road_address"":{", "}") vOldAddress = Split(sOldAddress, ",") OldCount = UBound(vOldAddress) If Len(sNewAddress) > 0 Then vNewAddress = Split(sNewAddress, ",") NewCount = UBound(vNewAddress) End If ReDim vResult(0 To OldCount + NewCount, 0 To 2) For i = 0 To OldCount vResult(i, 0) = "지번주소" vResult(i, 1) = Replace(Split(vOldAddress(i), ":")(0), """", "") vResult(i, 2) = Replace(Split(vOldAddress(i), ":")(1), """", "") Next If Len(sNewAddress) > 0 Then For i = 0 To NewCount vResult(i + OldCount, 0) = "도로명주소" vResult(i + OldCount, 1) = Replace(Split(vNewAddress(i), ":")(0), """", "") vResult(i + OldCount, 2) = Replace(Split(vNewAddress(i), ":")(1), """", "") Next End If GetAddress = vResult 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") If isWinHttp = False Then Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP") Else Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1") End If objHTTP.setTimeouts 3000, 3000, 3000, 3000 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 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 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 Sub ExportText(InnerStrings As String, Optional fileName As String = "텍스트추출", Optional Path As String) '############################################################### '오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com) '▶ Export_Text 함수 '▶ 문자열을 텍스트파일로 추출합니다. '▶ 인수 설명 '_____________InnerStrings : 텍스트파일로 추출할 문자열입니다. '_____________fileName : 텍스트 파일 이름입니다. 기본값은 "텍스트추출" 입니다. (선택인수) '_____________path : 텍스트 파일을 생성할 경로입니다. 기본값은 바탕화면입니다. (선택인수) '▶ 사용 예제 'ExportText "추출할 텍스트" '############################################################### Dim TextFile As Integer Dim FilePath As String If Path = "" Then Path = Environ("USERPROFILE") & "\Desktop\" If Right(Path, 1) <> "\" Then Path = Path & "\" FilePath = Path & fileName & ".txt" TextFile = FreeFile Open FilePath For Output As TextFile Print #TextFile, InnerStrings Close TextFile End Sub Sub ArrayToRng(startRng As Range, Arr As Variant, Optional ColumnNo As String = "", Optional LinkColumnNo As String = "") '############################################################### '오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com) '▶ ArrayToRng 함수 '▶ 배열을 범위 위로 반환합니다. '▶ 인수 설명 '_____________startRng : 배열을 반환할 기준 범위(셀) 입니다. '_____________Arr : 반환할 배열입니다. '_____________ColumnNo : [선택인수] 배열의 특정 열을 선택하여 범위로 반환합니다. 여러개 열을 반환할 경우 열 번호를 쉼표로 구분하여 입력합니다. ' 값으로 공란을 입력하면 열을 건너뜁니다. '_____________LinkColumNo : [선택인수] 하이퍼링크로 출력할 열 번호입니다. 쉼표로 구분하여 입력합니다. '▶ 사용 예제 'Dim v As Variant 'ReDim v(0 to 1) ''v(0) = "a" : v(1) = "b" 'ArrayToRng Sheet1.Range("A1"), v '▶ 사용된 보조 명령문 'Extract_Column 함수 '############################################################## On Error GoTo SingleDimension: Dim Cols As Variant: Dim Col As Variant Dim LinkCols As Variant: Dim LinkCol As Variant Dim i As Long: Dim X As Long: X = 1 Dim colNo As Long If ColumnNo = "" Then startRng.Cells(1, 1).Resize(UBound(Arr, 1) - LBound(Arr, 1) + 1, UBound(Arr, 2) - LBound(Arr, 2) + 1) = Arr If LinkColumnNo <> "" Then LinkCols = Split(LinkColumnNo, ",") For Each LinkCol In LinkCols For i = 1 To UBound(Arr, 1) - LBound(Arr, 1) + 1 colNo = CLng(Trim(LinkCol)) startRng.Parent.Hyperlinks.Add startRng.Cells(i, colNo), startRng.Cells(i, colNo).Value Next Next End If Else Cols = Split(ColumnNo, ",") LinkCols = Split(LinkColumnNo, ",") For Each Col In Cols If Trim(Col) <> "" Then startRng.Cells(1, X).Resize(UBound(Arr, 1) - LBound(Arr, 1) + 1) = Extract_Column(Arr, CLng(Trim(Col))) For Each LinkCol In LinkCols If Trim(LinkCol) = Trim(Col) Then For i = 1 To UBound(Arr, 1) - LBound(Arr, 1) + 1 startRng.Parent.Hyperlinks.Add startRng.Cells(i, X), startRng.Cells(i, X).Value Next End If Next End If X = X + 1 Next End If Exit Sub SingleDimension: Dim tempArr As Variant ReDim tempArr(LBound(Arr, 1) To UBound(Arr, 1), 1 To 1) For i = LBound(Arr, 1) To UBound(Arr, 1) tempArr(i, 1) = Arr(i) Next startRng.Cells(1, 1).Resize(UBound(Arr, 1) - LBound(Arr, 1) + 1, 1) = tempArr End Sub '######################## ' 배열에서 특정 열 데이터만 추출합니다. ' Array = Extract_Column(Array, 1) '######################## Function Extract_Column(DB As Variant, Col As Long) As Variant Dim i As Long Dim vArr As Variant ReDim vArr(LBound(DB) To UBound(DB), 1 To 1) For i = LBound(DB) To UBound(DB) vArr(i, 1) = DB(i, Col) Next Extract_Column = vArr End Function