EXCEL - VBA

VBA - vworld 사이트에서 토지 특성 조회(3) : 코드

별동산 2025. 3. 12. 08:09
반응형

매크로가 저장되지 않은 엑셀 파일은 아래와 같습니다

get_land_char.xlsx
0.01MB

 

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번에 나눠서 진행하도록 하겠습니다.

반응형