관련: 지식인

 

juso.go.kr

 

 기능 소개

 

위 도로명주소 검색사이트 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

 

  실행화면:

 

 

 

샘플 파일 첨부:

Juso주소변환1.xlsm
0.04MB