프로그램 설명
data.go.kr (공공데이터포털)의 OpenAPI를 활용하여 토지에 대한 표준식별체계로 사용되는 번호인 PNU(Parcel Numbering Unit)로부터 건축물정보를 가져와 엑셀 시트에 표시하는 역할을 수행합니다.
사용법 및 사용시 유의사항
아래글과 같습니다. 아래글 참고하세요.
활용신청URL
https://www.data.go.kr/data/15057464/openapi.do
다운로드
코드
Option Explicit
Private Sub GetDataFromAPI2()
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 SERVICE KEY"
Const MAX_ROWS As Long = 2000 ' 처리할 최대 행 수
Const START_ROW As Long = 5 ' 데이터 출력 시작 행
' pnu가 있는 A열의 범위 설정 (A5부터 시작)
Dim pnuRange As Range
Set pnuRange = targetSheet.Range("A" & START_ROW & ":A" & Cells.Item(Rows.Count, "A").End(xlUp).Row)
If Not CheckValues(pnuRange) Then
MsgBox "입력된 범위에 빈셀이 있거나 입력한 pnu값이 형식(숫자 19자리)에 맞지 않습니다."
Exit Sub
End If
' 필요한 변수 및 객체 선언
Dim startTime As Double
Dim endTime As Double
Dim executionTime As Double
Dim pnuRangeValue As Variant
Dim xDoc As MSXML2.DOMDocument60
Dim httpRequest As Object
Dim xmlResponse As String
Dim rowOffset As Long
Dim pnuSingleValue 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 rowIndex As Long
Dim outerArr() As Variant
Dim dataArr() As Variant
' 시작 시간 기록
startTime = Timer
' 셀 값을 지우고 셀 형식 변경
targetSheet.Range("B" & START_ROW & ":Z" & START_ROW + MAX_ROWS).ClearContents
targetSheet.Range("B" & START_ROW & ":Z" & START_ROW + MAX_ROWS).NumberFormat = "General"
targetSheet.Range("C" & START_ROW & ":C" & START_ROW + MAX_ROWS).NumberFormat = "@"
targetSheet.Range("F" & START_ROW & ":F" & START_ROW + MAX_ROWS).NumberFormat = "@"
targetSheet.Range("Z" & START_ROW & ":Z" & START_ROW + MAX_ROWS).NumberFormat = "yyyy-mm-dd"
' pnuRangeValue가 단일 셀인지 확인
pnuRangeValue = GetRangeValuesToArray(pnuRange)
' pnuRangeValue의 행 수를 기준으로 dataArr 배열의 크기를 조정
ReDim outerArr(1 To UBound(pnuRangeValue, 1))
' 새로운 XMLHTTP 요청을 생성
Set httpRequest = CreateObject("MSXML2.XMLHTTP")
' pnuRangeValue의 각 항목에 대해 반복
For rowOffset = 1 To UBound(pnuRangeValue, 1)
pnuSingleValue = pnuRangeValue(rowOffset, 1)
' URL 빌드
URL = "https://apis.data.go.kr/1611000/nsdi/BuildingUseService/attr/getBuildingUse?&numOfRows=100&format=xml&serviceKey=" & serviceKey & "&pnu=" & pnuSingleValue
' 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 Not errNode Is Nothing Then
errCode = errNode.Text
ReDim dataArr(1 To 1, 1 To 23)
dataArr(1, 1) = errCode
Else
' XML 응답 파싱
Set xNodes = xDoc.SelectNodes("/response/fields/field")
' XML 응답 데이터 갯수 확인
totalCount = xDoc.SelectSingleNode("/response/totalCount").Text
' 빈 배열을 위한 작업
If totalCount = 0 Then
ReDim dataArr(1 To 1, 1 To 23)
' errCode를 0으로 설정
dataArr(1, 1) = 0
End If
' URL XML 응답을 파싱
If totalCount > 0 Then
'xNodes.Length를 기반으로 dataArr 배열의 크기를 조정
ReDim dataArr(1 To xNodes.Length, 1 To 23)
rowIndex = 0
For Each xNode In xNodes
rowIndex = rowIndex + 1
'errCode를 0으로 설정
dataArr(rowIndex, 1) = 0
If Not xNode.SelectSingleNode("ldCodeNm") Is Nothing Then
dataArr(rowIndex, 2) = xNode.SelectSingleNode("ldCodeNm").Text
End If
If Not xNode.SelectSingleNode("mnnmSlno") Is Nothing Then
dataArr(rowIndex, 3) = xNode.SelectSingleNode("mnnmSlno").Text
End If
If Not xNode.SelectSingleNode("agbldgSeCodeNm") Is Nothing Then
dataArr(rowIndex, 4) = xNode.SelectSingleNode("agbldgSeCodeNm").Text
End If
If Not xNode.SelectSingleNode("buldKndCodeNm") Is Nothing Then
dataArr(rowIndex, 5) = xNode.SelectSingleNode("buldKndCodeNm").Text
End If
If Not xNode.SelectSingleNode("buldNm") Is Nothing Then
dataArr(rowIndex, 6) = xNode.SelectSingleNode("buldNm").Text
End If
If Not xNode.SelectSingleNode("buldDongNm") Is Nothing Then
dataArr(rowIndex, 7) = xNode.SelectSingleNode("buldDongNm").Text
End If
If Not xNode.SelectSingleNode("buldMainAtachSeCodeNm") Is Nothing Then
dataArr(rowIndex, 8) = xNode.SelectSingleNode("buldMainAtachSeCodeNm").Text
End If
If Not xNode.SelectSingleNode("buldPlotAr") Is Nothing Then
dataArr(rowIndex, 9) = xNode.SelectSingleNode("buldPlotAr").Text
End If
If Not xNode.SelectSingleNode("buldBildngAr") Is Nothing Then
dataArr(rowIndex, 10) = xNode.SelectSingleNode("buldBildngAr").Text
End If
If Not xNode.SelectSingleNode("buldTotar") Is Nothing Then
dataArr(rowIndex, 11) = xNode.SelectSingleNode("buldTotar").Text
End If
If Not xNode.SelectSingleNode("measrmtRt") Is Nothing Then
dataArr(rowIndex, 12) = xNode.SelectSingleNode("measrmtRt").Text
End If
If Not xNode.SelectSingleNode("btlRt") Is Nothing Then
dataArr(rowIndex, 13) = xNode.SelectSingleNode("btlRt").Text
End If
If Not xNode.SelectSingleNode("strctCodeNm") Is Nothing Then
dataArr(rowIndex, 14) = xNode.SelectSingleNode("strctCodeNm").Text
End If
If Not xNode.SelectSingleNode("mainPrposCodeNm") Is Nothing Then
dataArr(rowIndex, 15) = xNode.SelectSingleNode("mainPrposCodeNm").Text
End If
If Not xNode.SelectSingleNode("detailPrposCode") Is Nothing Then
dataArr(rowIndex, 16) = xNode.SelectSingleNode("detailPrposCodeNm").Text
End If
If Not xNode.SelectSingleNode("buldPrposClCodeNm") Is Nothing Then
dataArr(rowIndex, 17) = xNode.SelectSingleNode("buldPrposClCodeNm").Text
End If
If Not xNode.SelectSingleNode("buldHg") Is Nothing Then
dataArr(rowIndex, 18) = xNode.SelectSingleNode("buldHg").Text
End If
If Not xNode.SelectSingleNode("groundFloorCo") Is Nothing Then
dataArr(rowIndex, 19) = xNode.SelectSingleNode("groundFloorCo").Text
End If
If Not xNode.SelectSingleNode("undgrndFloorCo") Is Nothing Then
dataArr(rowIndex, 20) = xNode.SelectSingleNode("undgrndFloorCo").Text
End If
If Not xNode.SelectSingleNode("prmisnDe") Is Nothing Then
dataArr(rowIndex, 21) = xNode.SelectSingleNode("prmisnDe").Text
End If
If Not xNode.SelectSingleNode("useConfmDe") Is Nothing Then
dataArr(rowIndex, 22) = xNode.SelectSingleNode("useConfmDe").Text
End If
If Not xNode.SelectSingleNode("lastUpdtDt") Is Nothing Then
dataArr(rowIndex, 23) = xNode.SelectSingleNode("lastUpdtDt").Text
End If
Next xNode
End If
End If
' outerArr에 dataArr 저장
outerArr(rowOffset) = dataArr
Next rowOffset
' pnu 값을 C 열로 복사
targetSheet.Range("C" & START_ROW & ":C" & targetSheet.Cells.Item(targetSheet.Rows.Count, "A").End(xlUp).Row).Value = pnuRange.Value
' 데이터를 시트에 출력할 지점 설정
Dim outputRange As Range
Set outputRange = targetSheet.Range("D" & START_ROW)
Dim i As Long
Dim innerArr() As Variant
Dim insertRowRange As Range
For i = 1 To UBound(outerArr, 1)
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("C" & outputRange.Row + 1 & ":C" & outputRange.Row + UBound(innerArr, 1) - 1)
insertRowRange.Insert Shift:=xlDown
End If
' 다음 출력 범위로 이동
Set outputRange = outputRange.Offset(UBound(innerArr, 1))
Next i
' B열에 행번호 매기기
Dim lastRow As Long
lastRow = targetSheet.Cells.Item(targetSheet.Rows.Count, "C").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, "C")) Then
targetSheet.Cells.Item(rowNumber, "B").Value = counter
counter = counter + 1
End If
Next rowNumber
' 종료 시간 기록
endTime = Timer
executionTime = endTime - startTime
' 완료 메세지 표시
MsgBox "데이터 조회가 완료되었습니다." & vbCrLf & "총 실행시간 : " & executionTime & "초"
' 헤더 행 포맷 설정 및 열 자동 맞춤
targetSheet.Range("A" & START_ROW - 1 & ":Z" & START_ROW - 1).HorizontalAlignment = xlCenter
targetSheet.Columns.Item("A:Z").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
' 입력된 값이 19자리의 숫자 문자열인지 확인
If Not IsNumeric(cell.Value) Or Len(cell.Value) <> 19 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
