Excel) OpenAPI를 이용한 공공데이터포털 법정동코드조회 및 pnu생성

프로그램 설명

data.go.kr (공공데이터포털)의 OpenAPI를 활용하여 입력된 주소로 부터 법정동코드를 조회하고 엑셀 시트에 표시하는 역할을 수행합니다.

코드는 XML 데이터를 파싱하여 필요한 정보를 추출하고, 추출한 정보를 엑셀 시트에 기록하는 작업을 수행하며 이를 통해 해당 주소에 대한 정보와 관련된 데이터를 엑셀에서 확인할 수 있습니다.

추가적으로, 주어진 지번 주소로부터 토지에 대한 표준식별체계로 사용되는 번호인 PNU(Parcel Numbering Unit)를 생성하는 부분도 포함되어 있습니다.

[[동영상은 이전글 동영상 앞부분 참고]]

사용시 유의사항

  1. 이 매크로는 data.go.kr에 회원가입 후 아래 서비스에 대한 Open API 활용신청을 한 후 api key를 엑셀 vba코드내 service key를 등록 후 사용 가능합니다.
  2. open api 신청 예시
    • 활용목적 : 기타(법정동코드 조회)
  3. 발급받은 api key로 vba 코드내 "REPLACE YOUR API KEY" 부분을 교체합니다.(아래 사용전 엑셀설정 참고)
  4. 일일트래픽은 10,000회이며(data.go.kr의 제한사항), 한번에 1,000회 이하 조회 가능합니다.(아래 에러코드 참조. 테스트 해보지는 않음)
  5. 엑셀 시트명 Sheet1의 시트명을 바꾸면 작동하지 않습니다. (다른 시트, 다른 파일에서 매크로 실행시 에러방지 위해 vba코드에서 시트이름 고정했으며 이름변경을 하려면 코드내 이름도 변경을 해야 합니다.)
  6. Sheet1의 기본폼을 변경 하지마세요.(열 삽입 등)
  7. 코드는 엑셀 2010에서 작성되었고, 해당 버전에서 정상적으로 작동합니다. (일반적으로 엑셀의 상위 버전에서도 호환성이 유지될 것입니다.)
  8. 코드를 사용함으로써 발생하는 오류나 문제에 대해서는 사용자 본인이 책임을 집니다. 또한, 업데이트된 주소 정보나 정확성에 대한 책임은 data.go.kr에 있습니다. 사용자는 항상 최신 정보를 확인하고, api를 사용함에 있어서 data.go.kr의 이용약관과 정책을 준수해야 합니다.
  9. 코드를 수정하고 출처를 표시하여 배포하는 것은 자유롭게 가능합니다. 그러나 상업적인 목적으로 이용하는 것은 허용되지 않습니다.

사용전 엑셀설정

엑셀에서 xml데이터를 가져오기 위한 필수 라이브러리인 Microsoft XML을 활성화해야 합니다. 또한 발급받은 api key를 올바르게 교체해야 코드가 정상적으로 작동합니다.

  1. 엑셀을 엽니다.(매크로 포함하여 엽니다)
  2. "개발도구" 메뉴를 선택하고 "Visual Baic" 메뉴를 클릭합니다.
  3. vba에디터에서 "도구" 메뉴를 클릭합니다.
  4. "참조"를 선택합니다.
  5. "Microsoft XML, v6.0" 을 찾아 선택합니다.
  6. "확인" 버튼을 클릭합니다.
  7. vba 에디터로 돌아가서 "REPLACE YOUR API KEY" 부분을 발급받은 api 키로 교체합니다. (아래 코드의 19행)
  8. vba 에디터를 종료합니다.

사용법(Sheet1에서)

  1. A5:A열에 지번을 제외한 법정동주소 입력(도로명주소가 아님)
  2. 다량의 주소입력시 입력범위내(A5:A)에 중간에 빈셀이 있으면 안됩니다. 빈셀의 경우 삭제 후 실행하세요.
  3. B5:B열의 지번 입력란은 선택입력사항으로 지번 입력시 pnu의 지번 형식에 맞추어 코드로 변환하여 pnu코드 생성합니다.
  4. 지번 입력시에는 주소 입력 범위와 맞춰야 합니다. (지번 입력란을 비워놓거나 아니면 주소입력한 범위와 동일하게 입력 해야합니다.)
  5. A2셀에 입력값은 여러 개의 주소가 검색될 경우 출력할 결과 수입니다.(숫자만 입력)
  6. 실행버튼 눌러 실행합니다.

결과출력

  1. 결과 출력전 C5:T2000까지의 기존 셀의 내용은 실행시 삭제됩니다.
  2. 결과는 순차로 주소를 조회 후 한번에 출력됩니다.
  3. A열, B열에 기입한 주소 및 지번은 D열과 E열로 단순복사되며 A2의 설정에 따라 입력한 주소당 조회된 주소가 여러 개인 경우 C행에 열을 삽입해 복수의 주소정보 출력합니다.
  4. 에러코드가 "INFO-0"일 경우라도 실행완료 후 빈셀은 조회가 안되는 값입니다.
  5. 주소 검색시 특정문자 포함시 해당 단어 삭제 조치 후 조회됩니다. 특정문자는 sql 명령어 (SELECT", "INSERT", "DELETE", "UPDATE", "CREATE", "DROP", "EXEC", "UNION", "FETCH", "DECLARE", "TRUNCATE") 및 특수문자( <,>,%,=) 입니다.

에러코드

  • 290 ERROR 인증키가 유효하지 않습니다. 인증키가 없는 경우 홈페이지에서 인증키를 신청하십시오.
  • 310 ERROR 해당하는 서비스를 찾을 수 없습니다. 요청인자 중 SERVICE를 확인하십시오.
  • 333 ERROR 요청위치 값의 타입이 유효하지 않습니다. 요청위치 값은 정수를 입력하세요.
  • 336 ERROR 데이터 요청은 한번에 최대 1,000건을 넘을 수 없습니다.
  • 337 ERROR 일별 트래픽 제한을 넘은 호출입니다. 오늘은 더이상 호출할 수 없습니다.
  • 500 ERROR 서버 오류입니다. 지속적으로 발생시 홈페이지로 문의(Q&A) 바랍니다.
  • 600 ERROR 데이터베이스 연결 오류입니다. 지속적으로 발생시 홈페이지로 문의(Q&A) 바랍니다.
  • 601 ERROR SQL 문장 오류입니다. 지속적으로 발생시 홈페이지로 문의(Q&A) 바랍니다.
  • 0 INFO 정상 처리되었습니다.
  • 300 INFO 관리자에 의해 인증키 사용이 제한되었습니다.
  • 200 INFO 해당하는 데이터가 없습니다.
  • 3 INFO 해당하는 데이터가 없습니다.

테스트사항

  • 이상현상 발생시 댓글달아주세요.

다운로드

openapi-법정동코드조회+pnu생성(온라인).xlsm
Size: 105KB
Version: v2
Published: 2024-01-12

코드

Option Explicit

Private Sub GetDataFromAPI5()

    On Error GoTo ErrorHandler
    
    ' 시트 설정
    Const targetSheetName As String = "Sheet1"
    Dim targetSheet As Worksheet
    Set targetSheet = Worksheets.[_Default](targetSheetName)
    
    ' 활성 시트가 원하는 시트인지 확인하고, 그렇지 않다면 서브를 종료
    If ActiveSheet.Name <> targetSheetName Then
        MsgBox "This code can only be executed on the " & targetSheetName & " sheet.", vbExclamation
        Exit Sub
    End If
    
    ' 서비스키 설정
    Const serviceKey As String = "REPLACE YOUR API KEY"
    
    ' 법정코드조회 서비스의 numOfRows 값 셀 위치 설정
    Dim numOfRowsValue As Long
    numOfRowsValue = targetSheet.Range("A2").value
    
    Const MAX_ROWS As Long = 2000 ' 처리할 최대 행 수
    Const START_ROW As Long = 5   ' 데이터 출력 시작 행
    
    ' 검색할 키워드(주소)가 있는 A열의 범위 설정 (A5부터 시작)
    Dim searchKeyRange As Range
    Set searchKeyRange = targetSheet.Range("A" & START_ROW & ":A" & targetSheet.Cells.Item(targetSheet.Rows.Count, "A").End(xlUp).Row)
    
    ' 검색할 지번이 있는 B열의 범위 설정 (B5부터 시작)
    Dim lotAddrRange As Range
    Dim lotAddrLastRow As Long
    lotAddrLastRow = targetSheet.Cells.Item(targetSheet.Rows.Count, "B").End(xlUp).Row
    
    ' 검색할 지번이 있는 B열의 범위 확인 및 배열변환
    If lotAddrLastRow >= START_ROW Then
        If searchKeyRange.Rows.Count <> lotAddrLastRow - START_ROW + 1 Then
            MsgBox "지번은 선택입력 사항이나 입력시에는 검색할 주소의 입력범위와 일치하여야 합니다.(Either all or none)", vbExclamation
            Exit Sub
        Else
            Set lotAddrRange = targetSheet.Range("B" & START_ROW & ":B" & lotAddrLastRow)
        
            ' lotAddrRange의 값을 배열로 가져옴
            Dim lotAddrRangeValue As Variant
            lotAddrRangeValue = GetRangeValuesToArray(lotAddrRange)
        End If
    End If
        
    If Not CheckValues(searchKeyRange) Then
        MsgBox "주소 입력셀에 입력값이 없거나 범위내 공백셀이 있습니다."
        Exit Sub
    End If
    
    ' 필요한 변수 및 객체 선언
    Dim startTime As Double
    Dim executionTime As Double
    
    Dim searchKeyRangeValue As Variant

    Dim httpRequest As Object
    Dim xDoc As MSXML2.DOMDocument60
    Dim xmlResponse As String
    
    Dim rowOffset As Long
    Dim searchKeySingleValue As String
    Dim encodedKeyword As String
    Dim URL As String
    
    Dim errNode As MSXML2.IXMLDOMNode
    Dim errCode As String
    Dim xNode As MSXML2.IXMLDOMNode
    Dim xNodes As MSXML2.IXMLDOMNodeList
    
    Dim totalCount As Long

    Dim lotAddrSingleValue As String
    Dim lotAddrCode As String
    
    Dim rowIndex As Long
    Dim nodeNames As Variant
    Dim i As Long
    Dim region_cd As String
            
    Dim outerArr() As Variant
    Dim dataArr() As Variant
    
    ' 시작 시간 기록
    startTime = Timer
    
    ' 셀 값을 지우고 셀 형식을 변경
    targetSheet.Range("C" & START_ROW & ":T" & START_ROW + MAX_ROWS).ClearContents
    targetSheet.Range("C" & START_ROW & ":T" & START_ROW + MAX_ROWS).NumberFormat = "General"
    targetSheet.Range("T" & START_ROW & ":T" & START_ROW + MAX_ROWS).NumberFormat = "@"
    
    ' searchKeyRange의 값을 배열로 가져옴
    searchKeyRangeValue = GetRangeValuesToArray(searchKeyRange)
    
    ' outerArr 배열의 크기를 searchKeyRangeValue의 행 수에 맞게 조정
    ReDim outerArr(1 To UBound(searchKeyRangeValue, 1))

    ' XMLHTTP 요청을 생성
    Set httpRequest = CreateObject("MSXML2.XMLHTTP")
    
    ' 각 searchKeyRangeValue 각 항목에 대해 반복
    For rowOffset = 1 To UBound(searchKeyRangeValue, 1)
        searchKeySingleValue = searchKeyRangeValue(rowOffset, 1)
        ' 검색할 키워드(주소)값에 sql키워드 및 특수문자를 포함시 제거 후 utf-8로 인코딩
        searchKeySingleValue = rmSQLKeywordsAndSpecialChars(searchKeySingleValue)
        encodedKeyword = encodeURL(searchKeySingleValue, True)
        
        ' URL 빌드
        ' 행정안전부_행정표준코드_법정동코드(https://www.data.go.kr/iim/api/selectAPIAcountView.do)
        URL = "https://apis.data.go.kr/1741000/StanReginCd/getStanReginCdList?pageNo=1&type=xml&flag=Y&serviceKey=" & serviceKey & "&numOfRows=" & numOfRowsValue & "&locatadd_nm=" & encodedKeyword
        
        ' GET 요청을 보내고 XML 응답 받기
        httpRequest.Open "GET", URL, False
        httpRequest.send
        xmlResponse = httpRequest.responseText
        
        ' XML 응답을 XML 문서에 로드
        Set xDoc = New MSXML2.DOMDocument60
        xDoc.LoadXML xmlResponse
        
        ' 에러를 위해 XML 응답을 파싱
        Set errNode = xDoc.SelectSingleNode("/OpenAPI_ServiceResponse/cmmMsgHeader/returnReasonCode")
        
        If errNode Is Nothing Then
            Set errNode = xDoc.SelectSingleNode("/RESULT/resultCode")
        End If
        
        If Not errNode Is Nothing Then
            errCode = errNode.Text
            ReDim dataArr(1 To 1, 1 To 15)
            dataArr(1, 1) = errCode
        Else
            ' XML 응답을 파싱
            Set xNodes = xDoc.SelectNodes("/StanReginCd/row")
            
            ' XML 응답 데이터 갯수 확인
            totalCount = xDoc.SelectSingleNode("/StanReginCd/head/totalCount").Text
            errCode = xDoc.SelectSingleNode("/StanReginCd/head/RESULT/resultCode").Text
            
            ' 빈 배열을 위해 빌드
            If totalCount = 0 Then
                ReDim dataArr(1 To 1, 1 To 15)
                dataArr(1, 1) = errCode
            End If
            
            ' URL XML 응답을 파싱
            If totalCount > 0 Then
                If Not IsEmpty(lotAddrRangeValue) Then
                    ' lotAddrRange 값을 배열로 가져옴
                    lotAddrSingleValue = lotAddrRangeValue(rowOffset, 1)
                    
                    ' lotAddrNoCode를 생성
                    lotAddrCode = genLotAddrCode(lotAddrSingleValue)
                End If
                
                ' dataArr에 저장
                ReDim dataArr(1 To xNodes.Length, 1 To 15)
                rowIndex = 0
                ' 각 노드 이름을 배열로 저장
                nodeNames = Array("region_cd", "sido_cd", "sgg_cd", "umd_cd", "ri_cd", "locatjumin_cd", "locatjijuk_cd", "locatadd_nm", "locat_order", "locat_rm", "locathigh_cd", "locallow_nm", "adpt_de")
                
                For Each xNode In xNodes
                    rowIndex = rowIndex + 1
                    
                    dataArr(rowIndex, 1) = errCode
                    For i = 0 To UBound(nodeNames)
                        If Not xNode.SelectSingleNode(nodeNames(i)) Is Nothing Then
                            dataArr(rowIndex, i + 2) = xNode.SelectSingleNode(nodeNames(i)).Text
                        End If
                    Next i
                    If Not IsEmpty(lotAddrRangeValue) Then
                        dataArr(rowIndex, UBound(nodeNames) + 3) = xNode.SelectSingleNode("region_cd").Text & lotAddrCode
                    End If
                Next xNode
            End If
        End If
        
        ' dataArr를 outerArr에 저장
        outerArr(rowOffset) = dataArr
        
    Next rowOffset
    
    ' searchKeyRange를 열 D로 복사
    targetSheet.Range("D" & START_ROW & ":D" & targetSheet.Cells.Item(targetSheet.Rows.Count, "A").End(xlUp).Row).value = searchKeyRange.value
    ' lotAddrRangeValue를 열 E로 복사
    If Not IsEmpty(lotAddrRangeValue) Then
        targetSheet.Range("E" & START_ROW & ":E" & targetSheet.Cells.Item(targetSheet.Rows.Count, "A").End(xlUp).Row).value = lotAddrRange.value
    End If
    
    ' 데이터를 시트에 출력하기 위한 outputRange 설정
    Dim outputRange As Range
    Set outputRange = targetSheet.Range("F" & START_ROW)
    
    Dim innerArr() As Variant
    Dim insertRowRange As Range
    For i = 1 To UBound(outerArr, 1)
        ' innerArr라는 배열 변수를 선언
        innerArr = outerArr(i)
        
        ' innerArr 데이터를 outputRange에 출력
        outputRange.Resize(UBound(innerArr, 1), UBound(innerArr, 2)).value = innerArr
        
        ' 삽입된 데이터를 위해 열 C에 행을 삽입
        If UBound(innerArr, 1) > 1 Then
            Set insertRowRange = targetSheet.Range("D" & outputRange.Row + 1 & ":D" & outputRange.Row + UBound(innerArr, 1) - 1)
            insertRowRange.Insert Shift:=xlDown
        End If
    
        ' 다음 출력 범위로 이동
        Set outputRange = outputRange.Offset(UBound(innerArr, 1))
    Next i
    
    ' C열에 행번호 추가
    Dim lastRow As Long
    lastRow = targetSheet.Cells.Item(targetSheet.Rows.Count, "D").End(xlUp).Row
    
    Dim rowNumber As Long
    Dim counter As Long
    counter = 1
    For rowNumber = START_ROW To lastRow
        If Not IsEmpty(targetSheet.Cells.Item(rowNumber, "D")) Then
            targetSheet.Cells.Item(rowNumber, "C").value = counter
            counter = counter + 1
        End If
    Next rowNumber
    
    ' 종료 시간 기록
    executionTime = Timer - startTime
    
    ' 완료 메세지 표시
    MsgBox "데이터 조회가 완료되었습니다." & vbCrLf & "총 실행시간 : " & executionTime & "초"
    
    ' 헤더 행을 서식 지정하고 열 너비를 자동 조정
    targetSheet.Range("A" & START_ROW - 1 & ":T" & START_ROW - 1).HorizontalAlignment = xlCenter
    targetSheet.Columns.Item("A:T").AutoFit
    
    Exit Sub
    
ErrorHandler:
    MsgBox "오류 발생: " & Err.Description
    
    ' 정리 작업
     Set httpRequest = Nothing
    
    Exit Sub
End Sub

Private Function CheckValues(ByRef rng As Range) As Boolean
    Dim cell As Range
    
    For Each cell In rng
        ' 빈 셀 확인
        If IsEmpty(cell) Then
            CheckValues = False
            Exit Function
        End If
    Next cell
    
    CheckValues = True
End Function

Private Function GetRangeValuesToArray(ByRef rng As Range) As Variant
    ' 범위를 배열로 변환
    Dim values As Variant
    If IsArray(rng.value) Then
        ' 범위가 다차원 배열인 경우
        values = rng.value
    Else
        ' 범위가 단일 셀인 경우
        ReDim values(1 To 1, 1 To 1)
        values(1, 1) = rng.value
    End If
    GetRangeValuesToArray = values
End Function

Private Function rmSQLKeywordsAndSpecialChars(ByRef inputString As String) As String
    ' sql 키워드 및 특수문자 목록
    Dim sqlAndSpecialChars As Variant
    sqlAndSpecialChars = Array("SELECT", "INSERT", "DELETE", "UPDATE", "CREATE", "DROP", "EXEC", "UNION", "FETCH", "DECLARE", "TRUNCATE", "<", ">", "=", "%")
        
    ' 입력 문자열의 복사본 생성
    Dim resultString As String
    resultString = inputString
    
    ' sql 키워드 및 특수문자 제거
    Dim i As Long
    For i = LBound(sqlAndSpecialChars) To UBound(sqlAndSpecialChars)
        resultString = Replace(resultString, sqlAndSpecialChars(i), "", Compare:=vbTextCompare)
    Next i
    
    ' 연속된 여러개의 공백 제거
    Do While InStr(resultString, "  ") > 0
        resultString = Replace(resultString, "  ", " ")
    Loop
    
    ' 선행 및 후행 공백제거
    resultString = Trim$(resultString)
    
    ' 결과 반환
    rmSQLKeywordsAndSpecialChars = resultString
End Function

Private Function encodeURL(ByRef varText As Variant, Optional ByRef blnEncode As Boolean = True) As String
    '**********************************************************************
    ' Function: encodeURL
    ' Description: This function converts a string containing Korean/English
    '              characters and special symbols into a web URL standard address.
    '
    ' Arguments:
    '   - varText: The string to be converted into a standard URL address.
    '   - blnEncode: (Optional) If set to TRUE, the result is returned. If set
    '                to FALSE, the function does nothing.
    '
    ' Returns:
    '   - If blnEncode is TRUE, the function returns the URL-encoded string.
    '   - If blnEncode is FALSE, the function returns an empty string.
    '
    ' Dependencies:
    '   - Requires the "htmlfile" object from Microsoft Internet Controls.
    '     Make sure the "Microsoft HTML Object Library" reference is added
    '     to your VBA project.
    '
    '**********************************************************************
    Static objHtmlfile As Object
    
    ' htmlfile 개체가 존재하지 않는 경우에만 생성
    If objHtmlfile Is Nothing Then
        Set objHtmlfile = CreateObject("htmlfile")
        With objHtmlfile.parentWindow
            .execScript "function encode(s) {return encodeURIComponent(s)}", "jscript"
        End With
    End If
    
    ' blnEncode가 TRUE인 경우, varText를 JavaScript 함수를 사용하여 인코딩
    If blnEncode Then
        encodeURL = objHtmlfile.parentWindow.encode(varText)
    End If
End Function

Private Function genLotAddrCode(ByRef inputString As String) As String
    Dim cleanedStr As String
    Dim mainLotAddr As String
    Dim subLotAddr As String
    Dim mtFlag As Long
    Dim lotAddrCode As String
    
    ' 문자열 내 모든 공백 제거 및 숫자, -와 "산"을 제외한 다른 텍스트 제거
    cleanedStr = vbNullString
    Dim i As Long
    For i = 1 To Len(inputString)
        Dim char As String
        char = Mid$(inputString, i, 1)
        If IsNumeric(char) Or char = "-" Or char = "산" Then
            cleanedStr = cleanedStr & char
        End If
    Next i
    
    ' 문자열에 '-'가 있는지 확인하여 mainAddrNo와 subAddrNo 구분
    If InStr(cleanedStr, "-") > 0 Then
        mainLotAddr = Left$(cleanedStr, InStr(cleanedStr, "-") - 1)
        subLotAddr = Mid$(cleanedStr, InStr(cleanedStr, "-") + 1)
    Else
        mainLotAddr = cleanedStr
        subLotAddr = "0"
    End If
    
    ' mainLotAddrNo의 맨 앞글자에 따라 mtFlag 결정
    If Left$(mainLotAddr, 1) = "산" Then
        mtFlag = 2
        mainLotAddr = Mid$(mainLotAddr, 2)
    Else
        mtFlag = 1
    End If
    
    ' mainLotAddrNo와 subAddrNo를 0000 형식으로 변환
    mainLotAddr = Format$(CInt(mainLotAddr), "0000")
    subLotAddr = Format$(CInt(subLotAddr), "0000")
    
    ' lotAddrNoCode 생성
    lotAddrCode = CStr(mtFlag) & mainLotAddr & subLotAddr
    
    ' addrNoCode 반환
    genLotAddrCode = lotAddrCode
End Function

Leave a Comment