관련: 지식인
✅ 기능 소개
위 도로명주소 검색사이트 https://juso.go.kr 의 주소 검색 서비스를 이용해서
주어진 엑셀 주소 목록에 대해
검색결과가 있는 경우 한글 도로명주소, 지번주소, 우편번호, 영문주소를 변환해줍니다.
검색어에 주소전체가 아니더라도 건물명이나 구, 도로명 등을 검색어로 입력하면 검색이 됩니다.
✅ 한글주소 ↔ 영어주소 변환:
검색결과가 있는 경우 한글주소와 영문주소를 출력하기 때문에
한글주소 ↔ 영어주소 변환에 이용할 수 있습니다.
우편번호를 검색하는데도 이용할 수 있습니다.
단,아파트 동-호수, 주택의 층, 지하 등의 정보는 직접 입력/변환하셔야 합니다.
※ 상세주소(동,층,호)를 포함한 영문 우편주소 표기방법 안내
1. 유형1) “동”과 “호” 표기 주소가 “세종특별자치시 도움6로 42” 이고 “705동 1104호” 인 경우
705-1104, 42 Doum 6-ro, Sejong-si, 30112, Republic of Korea
2. 유형2) “층” 표기 주소가 “세종특별자치시 도움6로 42” 이고 “3층” 인 경우
3F, 42 Doum 6-ro, Sejong-si, 30112, Republic of Korea
3. 유형3) “지하” 표기 주소가 “세종특별자치시 도움6로 42” 이고 “지하102” 인 경우
B102, 42 Doum 6-ro, Sejong-si, 30112, Republic of Korea
✅ 사용법:
엑셀 시트 A열에 주소를 입력해놓고
셀 위에 마우스를 우클릭하면 juso.go.kr 메뉴가 뜹니다.
주소변환_전체: | 모든 셀의 주소를 검색 |
주소변환_현재행: | 현재 행의 주소만 검색 |
주소변환_선택행: | 선택된 행들의 주소를 검색 |
✅ 지도보기 기능:
검색이 안되면 우편번호에 0을 출력합니다.
검색된 경우 우편번호에 하이퍼링크가 걸리는데 이 링크를 누르면
아래처럼 웹브라우저에 지도보기가 떠서 실제 위치를 확인이 가능합니다.
✅ VBA 코드:
Option Explicit
Dim http As Object
Sub 주소변환_전체() 'getAllAddress()
Dim sht As Worksheet
Dim rng As Range
Dim lastRow As Range
Set sht = ActiveSheet
Set lastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp)
If lastRow.Row < 2 Then Exit Sub
On Error Resume Next
For Each rng In sht.Range("A2", lastRow)
Call getJuso(rng)
'Exit For
'잠시 대기
If rng.Row Mod 5 = 0 Then Application.Wait Now() + TimeSerial(0, 0, 1)
Next rng
End Sub
Sub 주소변환_선택행() 'getSelectedAddress()
Dim sht As Worksheet
Dim rng As Range
Dim lastRow As Range
Set sht = ActiveSheet
On Error Resume Next
For Each rng In ActiveWindow.Selection
Call getJuso(sht.Range("A" & rng.Row))
If rng.Row Mod 5 = 0 Then Application.Wait Now() + TimeSerial(0, 0, 1)
Next rng
End Sub
Sub 주소변환_현재행() 'getThisAddress()
Dim sht As Worksheet
Dim rng As Range
Set rng = ActiveCell
Set sht = rng.Parent
'On Error Resume Next
getJuso sht.Range("A" & rng.Row)
End Sub
Function getJuso(addr As Range)
Dim URL As String: URL = "https://www.juso.go.kr/support/AddressMainSearch.do?searchKeyword="
Dim sUrl As String
Dim html As New MSHTML.HTMLDocument
Dim mlink As String, argu As String, arr() As String, i As Integer
If http Is Nothing Then
Set http = CreateObject("MSXML2.ServerXmlHttp")
If http Is Nothing Then Exit Function
End If
With http
sUrl = addr
'60글자 이상인 경우 짤림
sUrl = Replace(sUrl, ", Republic of Korea", "")
If Len(sUrl) > 60 Then sUrl = Left(sUrl, InStrRev(sUrl, ",") - 1)
'sUrl = Replace(addr, ",", "")
sUrl = Application.WorksheetFunction.EncodeURL(sUrl)
URL = URL & sUrl
'Debug.Print Url
.Open "get", URL, False
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/114.0.0.0 Safari/537.36"
.send
html.body.innerHTML = .responseText
'Save2File (.responseText)
End With
If html.getElementsByClassName("addr_cont").Length Then
addr.Offset(, 1).NumberFormat = "@"
addr.Offset(, 1).HorizontalAlignment = xlCenter
addr.Offset(, 1) = Format(html.getElementById("bsiZonNo1").Value, "00000")
addr.Offset(, 2) = html.getElementById("rnAddr1").Value
addr.Offset(, 3) = html.getElementById("lndnAddr1").Value
addr.Offset(, 4) = html.getElementById("ClipEng1").Value
'지도보기
'javascript:miniMapLoadNew('385281.389607177','684809.346357347','1144010900101740014006648','114403113022','53','0','28','','385281.389607177','684809.346357347', '0', '114403113022','', 1,'list1','1144010900'
'MAP_HOST_URL + '/gismap-new/MapIndex.do?value=point&code='+code+'&bdmgtsn='+bdMgtSn+'&searchStr='+encodeURIComponent(searchStr)+"&rdsMgtSn="+rdsMgtSn+"&bdMaSn="+bdMnnn+"&bdSlno="+bdSlno+"&adrDcCount="+adrDcCount+"&bdKd="+bdKd+"&entD="+entD+"&entK="+entK+"&eqbManSn="+eqbManSn+"&sigCd="+sigCd+"&udrtYn="+udrtYn+'&rnAddr='+encodeURIComponent(rnAddr)+'&lndnAddr='+encodeURIComponent(lndnAddr)+'&bdNm='+encodeURIComponent(bdNm)+"&bsiZonNo="+bsiZonNo+"&rdMgtSn="+rnMgtSn+"&emdCd="+emdCd+"&liCd="+liCd, '지도서비스', 'width='+screen.availWidth+',height='+screen.availHeight+',left=0,top=0, menubar=no,status=no,directiories=no'
argu = html.getElementsByClassName("mapsee")(0).getElementsByTagName("a")(0).onclick
arr() = Split(argu, ",")
For i = LBound(arr) To UBound(arr)
If InStr(arr(i), "'") > 0 Then
arr(i) = Mid(arr(i), InStr(arr(i), "'") + 1)
arr(i) = Left(arr(i), InStrRev(arr(i), "'") - 1)
End If
Next i
'Debug.Print arr(0)
addr.Offset(, 1).Hyperlinks.Delete
mlink = "https://m1.juso.go.kr/gismap-new/MapIndex.do?value=point&code="
mlink = mlink & arr(0) & "^" & arr(1) & "&bdmgtsn=" & arr(2) & "&searchStr=" & sUrl
addr.Offset(, 1).Hyperlinks.Add addr.Offset(, 1), mlink
Else
addr.Offset(, 1) = 0 '//검색결과가 0인 경우 우편번호에 0을 표시
End If
End Function
Function Save2File(str As String)
Dim h As Integer
h = FreeFile
Open ThisWorkbook.Path & "\t.html" For Output As #h
Print #h, str
Close #h
End Function
'///////////////////////////
'//// 현재통합문서의 코드:
'///////////////////////////
Const MenuName = "juso.go.kr"
Private Sub Workbook_Open()
addContextMenu
End Sub
Function addContextMenu()
Dim cmdPop As CommandBarPopup
Dim cmdBtn As CommandBarButton
Dim i As Integer
Dim Arr1 As Variant, Arr2 As Variant
Arr1 = Array("주소변환_전체", "주소변환_현재행", "주소변환_선택행") '매크로명령
Arr2 = Array(156, 3849, 3524) 'FaceID
On Error Resume Next
With Application
.CommandBars("Cell").Controls("myMenu").Delete
Set cmdPop = .CommandBars("Cell").Controls.Add(Type:=msoControlPopup, Before:=1, Temporary:=True)
End With
With cmdPop
.Caption = MenuName
'.Style = msoButtonCaption
'.OnAction = "myMeu"
For i = LBound(Arr1) To UBound(Arr1)
Set cmdBtn = .Controls.Add(Type:=msoControlButton, Temporary:=True)
With cmdBtn
.Caption = Arr1(i)
.Style = msoButtonIconAndCaption
.OnAction = Arr1(i)
.FaceId = Arr2(i)
.ShortcutText = "Ctrl+" & i
End With
Next i
End With
On Error GoTo 0
End Function
✅ 실행화면:
✅ 샘플 파일 첨부:
'XLS+VBA' 카테고리의 다른 글
네이버 API를 이용한 '네이버 쇼핑' 검색 결과 수집 (0) | 2024.02.20 |
---|---|
엑셀에서 실시간 유튜브 구독자수 모니터링 (0) | 2024.02.15 |
온라인 이미지를 다운로드하여 아래로 이어 붙인 상품 이미지 일괄 생성 (0) | 2024.02.14 |
엑셀에서 ppt의 특정 페이지를 링크 (0) | 2023.11.21 |
영어단어와 뜻 OCR인식 결과 정리하기 (0) | 2023.06.12 |
PPT파일 순서를 확인/정렬해서 합치기 (0) | 2023.02.11 |
구글 이미지 검색 결과 가져오기 (0) | 2023.02.01 |
JsonBag 클래스를 이용한 Json데이터 파싱 (0) | 2023.01.01 |
최근댓글