반응형
매크로가 저장되지 않은 엑셀 파일은 아래와 같습니다
4. 코드
가. 전체 구성
크게 parse_xml이라는 Sub 프로시저 1개와 search_value와 fail이라는 Function 2개로 구성되어 있습니다.
Sub 프로시저 하나로 해도 되지만 공통되는 부분을 Function으로 뺐으며, 내용은 아래와 같습니다.
이것도 내용별로 구분할 수도 있을 겁니다.
Option Explicit
Sub parse_xml()
Dim xmlDoc As Object
Dim ws As Worksheet
Dim xmlHttp As New MSXML2.ServerXMLHTTP60
Dim base_url As String, params As String, search_url As String
Dim dong As String, jibun As String
Dim value() ' 여러 개 값을 반환받을 수 있도록 반환 값을 배열로 처리
Dim pnu As String
Dim endRow As Long, i As Long
' Sheet1 시트를 ws 변수에 저장
Set ws = ThisWorkbook.Sheets("Sheet1")
' XML 객체 생성
Set xmlDoc = CreateObject("MSXML2.DOMDocument.6.0")
xmlDoc.async = False
endRow = Cells(Rows.Count, "A").End(xlUp).Row
' 머리글 입력
ws.Cells(1, 3).value = "주소"
ws.Cells(1, 4).value = "면적(㎡)"
ws.Cells(1, 5).value = "기준연도"
ws.Cells(1, 6).value = "공시지가(원/㎡)"
For i = 2 To endRow
''PNU 조회
' 법정동과 지번으로 구분 입력
' 지번 입력시 산과 지번 사이 공백은 있거나 없거나 잘됨
dong = Range("A" & i)
jibun = Range("B" & i)
' D열과 F열의 셀 서식을 3자리마다 쉼표 삽입으로 설정
'Range("d:d,f:f").NumberFormat = "#,##0"
Range("d:d").NumberFormat = "#,##0.0"
Range("f:f").NumberFormat = "#,##0"
' 법정동 코드 조회 검색 URL 만들기(domain 지정안해도 됨)
base_url = "https://api.vworld.kr/req/address"
params = "?service=address&request=getcoord&version=2.0&crs=epsg:4326"
params = params & "&address=" & WorksheetFunction.EncodeURL(dong & " " & jibun)
params = params & "&refine=true&simple=false&format=xml&type=parcel"
params = params & "&key=CEB52025-E065-364C-9DBA-44880E3B02B8"
' search_url을 base_url과 params의 결합으로 지정
search_url = base_url & params
' PNU 조회 함수
value = search_value(ws, i, value, xmlHttp, xmlDoc, search_url)
pnu = value(0)
If pnu = "" Then
GoTo cont_loc
End If
' 토지 특성 조회 URL 만들기(기준연도 초기값 올해)
base_url = "http://api.vworld.kr/ned/data/getLandCharacteristics"
params = "?pnu=" & pnu & "&format=xml" & "&key=CEB52025-E065-364C-9DBA-44880E3B02B8"
' params = params & "&numOfRows=3"
params = params & "&stdrYear=" & Year(Date)
' search_url을 base_url과 params의 결합으로 함
search_url = base_url & params
' URL 조회 및 검색 결과 반환 처리
value = search_value(ws, i, value, xmlHttp, xmlDoc, search_url)
' 검색 결과가 없을 때는 C열부터 F열까지 지우고 끝냄
If value(0) = "" Then
GoTo cont_loc
End If
' 검색 결과 표시
' 주소 표시
ws.Cells(i, 3).value = dong & " " & jibun
' 면적
ws.Cells(i, 4).value = value(0)
' 개별 공시지가 기준연도
ws.Cells(i, 5).value = value(1)
' 개별 공시지가
ws.Cells(i, 6).value = value(2)
'중간을 건너뛰고 여기로 옮
cont_loc:
Next
' A열부터 F열까지 열 너비 자동 조절
Columns("a:f").AutoFit
' 완료 메시지 표시
Range("c2").Select
MsgBox "데이터 추출 완료!"
End Sub
Function search_value(ws, i, value, xmlHttp, xmlDoc, search_url)
' Dim value()
Dim stdrYear As Integer
Dim strResult As String
Dim omitYearURL As String
' 법정동 조회가 아닌 경우 stdrYear 이후를 제거한 다음
' stdrYear를 한 해 작은 것으로 연결
If InStr(search_url, "address") = 0 Then
'기준연도를 올해로
stdrYear = Year(Date)
'기준연도를 제외한 url 추출
omitYearURL = Left(search_url, InStr(search_url, "stdrYear") - 1)
minusYear:
' 연도를 하나씩 빼서 결과값이 나올 때까지 반복
search_url = omitYearURL & "stdrYear=" & stdrYear
End If
' GET 방식 URL을 전송
xmlHttp.Open "GET", search_url, False
xmlHttp.setRequestHeader "Content-Type", "text/xml"
xmlHttp.send
If xmlHttp.Status = 200 Then
'응답결과를 strResult 변수에 저장
strResult = xmlHttp.responseText
xmlDoc.LoadXML (strResult)
'법정동 코드 조회인 경우
If InStr(search_url, "address") Then
'검색 결과에 level4LC가 있는 경우
If InStr(strResult, "level4LC") > 0 Then
' value 배열의 요소 개수 재선언
ReDim value(0)
value(0) = xmlDoc.SelectSingleNode("//level4LC").Text
' value(0) = xmlDoc.SelectSingleNode("/response/refined/structure/level4LC").Text
' value 배열을 반환 값인 searchvalue에 대입
search_value = value
Else
search_value = fail(ws, i)
End If
'개별 공시지가 조회인 경우
Else
If InStr(strResult, "pblntfPclnd") = 0 Then
stdrYear = stdrYear - 1
GoTo minusYear
End If
' value 배열의 요소(item) 개수 재선언
ReDim value(2)
'면적
' value(0) = xmlDoc.SelectSingleNode("/response/fields/field/lndpclAr").Text
value(0) = xmlDoc.SelectSingleNode("//lndpclAr").Text
'표준연도
value(1) = xmlDoc.SelectSingleNode("//stdrYear").Text
'개별공시지가
value(2) = xmlDoc.SelectSingleNode("//pblntfPclnd").Text
' value 배열을 반환 값인 searchvalue에 대입
search_value = value
End If
Else
search_value = fail(ws, i)
End If
End Function
Function fail(ws, i)
ReDim value(0)
value(0) = ""
ws.Cells(i, 3).Resize(1, 4).ClearContents
fail = value
End Function
나. 프로그램 흐름도(절차)
토지특성속성을 조회할 때 PNU(고유번호)가 필수 인수인데, 주소만 알고 있기 때문에
① 주소를 기준으로 해당하는 PNU를 구하고,
② 토지특성을 조회하는 URL의 인수로 전달해서
③ 지목, 면적 등 원하는 정보를 추출한 후
④ 워크시트에 기록하는 순서로 진행됩니다.
VBA에 대한 어느 정도의 실력이 있다면 위 내용을 get_land_char.xls의 코드 창에 붙여 넣고 실행하면 되므로 어렵지 않을 것입니다.
그러나, 초보자 분은 위 코드만 보고도 질릴 수 있으므로 여기서 잠시 멈추고,
코드에 대한 설명은 내용이 많으므로 다음 편부터 2번에 나눠서 진행하도록 하겠습니다.
반응형
'EXCEL - VBA' 카테고리의 다른 글
VBA - vworld 사이트에서 토지 특성 조회(2) : 도구 - 참조에서 XML v6.0 추가 (0) | 2025.03.11 |
---|---|
VBA - vworld 사이트에서 토지 특성 조회(1) : 토지특성속성조회 API (0) | 2025.03.10 |
범위를 지정하는 방법(2) - Selection (0) | 2025.02.21 |
범위를 지정하는 방법(1) - Application.InputBox (0) | 2025.02.20 |
지정된 색이 포함된 행을 위로 올리기 (0) | 2025.02.19 |