프로그램 설명
data.go.kr (공공데이터포털)의 OpenAPI를 활용하여 입력된 주소로 부터 법정동코드를 조회하고 엑셀 시트에 표시하는 역할을 수행합니다.
코드는 XML 데이터를 파싱하여 필요한 정보를 추출하고, 추출한 정보를 엑셀 시트에 기록하는 작업을 수행하며 이를 통해 해당 주소에 대한 정보와 관련된 데이터를 엑셀에서 확인할 수 있습니다.
추가적으로, 주어진 지번 주소로부터 토지에 대한 표준식별체계로 사용되는 번호인 PNU(Parcel Numbering Unit)를 생성하는 부분도 포함되어 있습니다.
[[동영상은 이전글 동영상 앞부분 참고]]
사용시 유의사항
- 이 매크로는 data.go.kr에 회원가입 후 아래 서비스에 대한 Open API 활용신청을 한 후 api key를 엑셀 vba코드내 service key를 등록 후 사용 가능합니다.
- 행정안전부 행정표준코드 법정동코드 조회(https://www.data.go.kr/iim/api/selectAPIAcountView.do)
- open api 신청 예시
- 활용목적 : 기타(법정동코드 조회)
- 발급받은 api key로 vba 코드내 "REPLACE YOUR API KEY" 부분을 교체합니다.(아래 사용전 엑셀설정 참고)
- 일일트래픽은 10,000회이며(data.go.kr의 제한사항), 한번에 1,000회 이하 조회 가능합니다.(아래 에러코드 참조. 테스트 해보지는 않음)
- 엑셀 시트명 Sheet1의 시트명을 바꾸면 작동하지 않습니다. (다른 시트, 다른 파일에서 매크로 실행시 에러방지 위해 vba코드에서 시트이름 고정했으며 이름변경을 하려면 코드내 이름도 변경을 해야 합니다.)
- Sheet1의 기본폼을 변경 하지마세요.(열 삽입 등)
- 코드는 엑셀 2010에서 작성되었고, 해당 버전에서 정상적으로 작동합니다. (일반적으로 엑셀의 상위 버전에서도 호환성이 유지될 것입니다.)
- 코드를 사용함으로써 발생하는 오류나 문제에 대해서는 사용자 본인이 책임을 집니다. 또한, 업데이트된 주소 정보나 정확성에 대한 책임은 data.go.kr에 있습니다. 사용자는 항상 최신 정보를 확인하고, api를 사용함에 있어서 data.go.kr의 이용약관과 정책을 준수해야 합니다.
- 코드를 수정하고 출처를 표시하여 배포하는 것은 자유롭게 가능합니다. 그러나 상업적인 목적으로 이용하는 것은 허용되지 않습니다.
사용전 엑셀설정
엑셀에서 xml데이터를 가져오기 위한 필수 라이브러리인 Microsoft XML을 활성화해야 합니다. 또한 발급받은 api key를 올바르게 교체해야 코드가 정상적으로 작동합니다.
- 엑셀을 엽니다.(매크로 포함하여 엽니다)
- "개발도구" 메뉴를 선택하고 "Visual Baic" 메뉴를 클릭합니다.
- vba에디터에서 "도구" 메뉴를 클릭합니다.
- "참조"를 선택합니다.
- "Microsoft XML, v6.0" 을 찾아 선택합니다.
- "확인" 버튼을 클릭합니다.
- vba 에디터로 돌아가서 "REPLACE YOUR API KEY" 부분을 발급받은 api 키로 교체합니다. (아래 코드의 19행)
- vba 에디터를 종료합니다.
사용법(Sheet1에서)
- A5:A열에 지번을 제외한 법정동주소 입력(도로명주소가 아님)
- 다량의 주소입력시 입력범위내(A5:A)에 중간에 빈셀이 있으면 안됩니다. 빈셀의 경우 삭제 후 실행하세요.
- B5:B열의 지번 입력란은 선택입력사항으로 지번 입력시 pnu의 지번 형식에 맞추어 코드로 변환하여 pnu코드 생성합니다.
- 지번 입력시에는 주소 입력 범위와 맞춰야 합니다. (지번 입력란을 비워놓거나 아니면 주소입력한 범위와 동일하게 입력 해야합니다.)
- A2셀에 입력값은 여러 개의 주소가 검색될 경우 출력할 결과 수입니다.(숫자만 입력)
- 실행버튼 눌러 실행합니다.
결과출력
- 결과 출력전 C5:T2000까지의 기존 셀의 내용은 실행시 삭제됩니다.
- 결과는 순차로 주소를 조회 후 한번에 출력됩니다.
- A열, B열에 기입한 주소 및 지번은 D열과 E열로 단순복사되며 A2의 설정에 따라 입력한 주소당 조회된 주소가 여러 개인 경우 C행에 열을 삽입해 복수의 주소정보 출력합니다.
- 에러코드가 "INFO-0"일 경우라도 실행완료 후 빈셀은 조회가 안되는 값입니다.
- 주소 검색시 특정문자 포함시 해당 단어 삭제 조치 후 조회됩니다. 특정문자는 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 해당하는 데이터가 없습니다.
테스트사항
- 이상현상 발생시 댓글달아주세요.
다운로드
코드
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 endTime 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 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
For Each xNode In xNodes
rowIndex = rowIndex + 1
dataArr(rowIndex, 1) = errCode
If Not xNode.SelectSingleNode("region_cd") Is Nothing Then
region_cd = xNode.SelectSingleNode("region_cd").Text
dataArr(rowIndex, 2) = region_cd
End If
If Not xNode.SelectSingleNode("sido_cd") Is Nothing Then
dataArr(rowIndex, 3) = xNode.SelectSingleNode("sido_cd").Text
End If
If Not xNode.SelectSingleNode("sgg_cd") Is Nothing Then
dataArr(rowIndex, 4) = xNode.SelectSingleNode("sgg_cd").Text
End If
If Not xNode.SelectSingleNode("umd_cd") Is Nothing Then
dataArr(rowIndex, 5) = xNode.SelectSingleNode("umd_cd").Text
End If
If Not xNode.SelectSingleNode("ri_cd") Is Nothing Then
dataArr(rowIndex, 6) = xNode.SelectSingleNode("ri_cd").Text
End If
If Not xNode.SelectSingleNode("locatjumin_cd") Is Nothing Then
dataArr(rowIndex, 7) = xNode.SelectSingleNode("locatjumin_cd").Text
End If
If Not xNode.SelectSingleNode("locatjijuk_cd") Is Nothing Then
dataArr(rowIndex, 8) = xNode.SelectSingleNode("locatjijuk_cd").Text
End If
If Not xNode.SelectSingleNode("locatadd_nm") Is Nothing Then
dataArr(rowIndex, 9) = xNode.SelectSingleNode("locatadd_nm").Text
End If
If Not xNode.SelectSingleNode("locat_order") Is Nothing Then
dataArr(rowIndex, 10) = xNode.SelectSingleNode("locat_order").Text
End If
If Not xNode.SelectSingleNode("locat_rm") Is Nothing Then
dataArr(rowIndex, 11) = xNode.SelectSingleNode("locat_rm").Text
End If
If Not xNode.SelectSingleNode("locathigh_cd") Is Nothing Then
dataArr(rowIndex, 12) = xNode.SelectSingleNode("locathigh_cd").Text
End If
If Not xNode.SelectSingleNode("locallow_nm") Is Nothing Then
dataArr(rowIndex, 13) = xNode.SelectSingleNode("locallow_nm").Text
End If
If Not xNode.SelectSingleNode("adpt_de") Is Nothing Then
dataArr(rowIndex, 14) = xNode.SelectSingleNode("adpt_de").Text
End If
If Not IsEmpty(lotAddrRangeValue) Then
dataArr(rowIndex, 15) = region_cd & 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 i As Long
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
' 종료 시간 기록
endTime = Timer
executionTime = endTime - 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
