프로그램 설명
data.go.kr (공공데이터포털)의 OpenAPI를 활용하여 토지에 대한 표준식별체계로 사용되는 번호인 PNU(Parcel Numbering Unit)로부터 토지임야정보, 토지특성정보, 개별공시지가, 토지이용계획 등의 정보를 가져와 엑셀 시트에 표시하는 역할을 수행합니다.
코드는 XML 데이터를 파싱하여 필요한 정보를 추출하고, 추출한 정보를 엑셀 시트에 기록하는 작업을 수행하며 이를 통해 해당 토지에 대한 정보와 관련된 데이터를 엑셀에서 확인할 수 있습니다.
사용시 유의사항
- 이 매크로는 data.go.kr에 회원가입 후 아래 4개 서비스에 대한 Open API 활용신청을 한 후 api key를 엑셀 vba코드내 service key를 등록 후 사용 가능합니다.
- 토지임야정보 조회(https://www.data.go.kr/data/15057917/openapi.do)
- 토지특성정보 조회(https://www.data.go.kr/data/15057558/openapi.do)
- 개별공사지가 조회(https://www.data.go.kr/data/15059127/openapi.do)
- 토지이용계획 조회(https://www.data.go.kr/data/15056930/openapi.do)
- open api 신청 예시
- 활용목적 : 기타(토지정보 조회)
- 발급받은 api key로 vba 코드내 "REPLACE YOUR API KEY" 부분을 교체합니다.(아래 사용전 엑셀설정 참고)
- 일일트래픽은 10,000회 입니다.(data.go.kr의 제한사항)
- 엑셀 시트명 Sheet1, Sheet2의 시트명을 바꾸면 작동하지 않습니다. (다른 시트, 다른 파일에서 매크로 실행시 에러방지 위해 vba코드에서 시트이름 고정했으며 이름변경을 하려면 코드내 이름도 변경을 해야 합니다.)
- Sheet1, Sheet2의 기본폼을 변경 하지마세요.(열 삽입 등)
- 코드는 엑셀 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 키로 교체합니다. (아래 코드의 33행)
- vba 에디터를 종료합니다.
사용법(Sheet1에서)
- A6:A열에 pnu 입력(코드내 최대행수를 2000으로 한정했지만 2000행의 기존 값을 삭제한다는 의미지 최대 2000개의 행으로 한정해 구동된다는 의미는 아닙니다. 최대 입력할 수 있는 행은 사용자 pc의 메모리량과 조회되는 결과에 따릅니다.)
- pnu코드는 숫자서식이 아닌 텍스트서식으로 입력합니다 (엑셀은 15자리 이상의 숫자는 15자리 하위에 0으로 채웁니다.)
- 다량의 주소입력시 입력범위내(A6:A)에 중간에 빈셀이 있으면 안됩니다. 빈셀의 경우 삭제 후 실행하세요.
- A3셀에는 토지이용계획 조회시 특정 키워드 1개를 조회할 경우 사용합니다.(예 농업진흥구역) 공백일 경우는 전체를 조회합니다.
- A4셀에 토지특성정보/개별공시지가의 기준년도 입력합니다.(숫자만 입력 예: 2023)
- 일괄실행 버튼 또는 실행(개별) 버튼 눌러 실행합니다..
결과출력(Sheet1)
- 결과 출력전 B6:AF2000까지의 기존 셀의 내용은 실행시 삭제됩니다.
- 결과는 순차로 모든 pnu값으로 조회 후 한번에 출력됩니다.(한개의 pnu당 4번의 조회로 실행시간이 다소 걸리 수 있습니다.)
- 에러코드가 "0"일 경우라도 실행완료 후 빈셀은 서버에서 조회가 안되는 값입니다.(데이터가 없는 경우 등으로 pnu 확인)
- 토지이용계획 키워드 검색시 특정문자 포함시 해당 단어 삭제 조치 후 조회됩니다. 특정문자는 sql 명령어 (SELECT", "INSERT", "DELETE", "UPDATE", "CREATE", "DROP", "EXEC", "UNION", "FETCH", "DECLARE", "TRUNCATE") 및 특수문자( <,>,%,=) 입니다.
- 토지이용계획에 대한 데이터기준일자는 엑셀에 표시하지 않았습니다.(각 용도지역마다 기준년도가 다른 경우가 있어 각 용도지역마다 기준년도를 모두 표기하기에는 너무 많고 데이터 표시하는 방법에 대한 고민과 지저분해서 기준년도 기입하지 않았습니다.)
결과출력(Sheet2)
- Sheet1에서 일괄실행시에만 집계결과 출력합니다. (조회를 개별적으로 한 경우 모든 조회를 완료해도 집계는 되지 않음)
- 결과 출력전 기존 셀의 내용은 삭제됩니다.
- 집계 결과 표시항목 : (법정동/지목/소유구분/소유(공유)인수/용도지역1/용도지역2/지형높이)별 면적 집계
에러코드
- 0 정상
- 1 어플리케이션 에러
- 4 HTTP 에러
- 12 해당 오픈 API 서비스가 없거나 폐기됨
- 20 서비스 접근거부
- 22 서비스 요청제한횟수 초과에러
- 30 등록되지 않은 서비스키
- 31 활용기간 만료
- 32 등록되지 않은 IP
- 99 기타에러
테스트사항
- 처리속도 관련해서 실제는 위의 영상처럼 빠르게 조회되지 않습니다. 일괄조회시 기본적으로 PNU 1개당 4번의 조회를 수행합니다. 개략 PNU 100개 정도 조회시 약 40~60초 정도 소요되는것 같습니다.(위 영상은 영상제작 전 사전에 미리 조회 후 다시 조회한 것으로 캐시로 인해 빠르게 조회되는 것으로 보입니다.)
- A열에 입력한 PNU는 약1300개 까지 테스트 하였으나 최대 입력할 수 있는 행수는 사용자 pc의 메모리량과 조회되는 결과의 양에 따릅니다.
- 해당필지를 "토지이음"에서 직접 조회해보면 data.go.kr의 정보 업데이트가 토지이음에 비해 늦습니다. (예를들어 개별공시지가 2023년도 토지이음에서 조회 가능하지만 data.go.kr에서는 아직 안됩니다. - 2023년 6월 13일 현재) 이점을 감안해 사용하시기 바랍니다.
- 실행시 에러코드 4를 반환할 경우가 있는데 이것을 서버에서 자료 업데이트시 나타나는 결과로 보입니다(추측). 일정 시간 경과 후 재실행 하면 됩니다.
- 이상현상 발생시 댓글달아주세요.
다운로드
코드
Option Explicit
Private argsNum As Long
Private Sub GetDataFromAPI(ByRef argsNum As Long)
On Error GoTo ErrorHandler
' 시트 설정
Const targetSheetName As String = "Sheet1"
Dim targetSheet As Worksheet
Set targetSheet = Worksheets(targetSheetName)
Const aggrSheetName As String = "Sheet2"
Dim aggrSheet As Worksheet
On Error Resume Next
Set aggrSheet = Worksheets(aggrSheetName)
On Error GoTo 0
' aggrSheet가 존재하는지 확인하고 없으면 서브를 종료
If aggrSheet Is Nothing Then
MsgBox aggrSheetName & "가 존재하지 않습니다.", vbExclamation
Exit Sub
End If
' 활성시트가 targetSheet인지 확인하고, 그렇지 않다면 서브를 종료
If ActiveSheet.Name <> targetSheetName Then
MsgBox "이 코드는 " & targetSheetName & " 시트에서만 실행할 수 있습니다.", vbExclamation
Exit Sub
End If
' 서비스키 설정
Const serviceKey As String = "REPLACE YOUR API KEY"
Const MAX_ROWS As Long = 2000 ' 처리할 최대 행 수
Const START_ROW As Long = 6 ' 데이터 출력 시작 행
' 토지이용계획정보 조회시 특정 키워드 검색 셀위치(A3)
Dim searchPrposAreaDstrcValue As String
searchPrposAreaDstrcValue = Range("A3").Value
' 토지특성정보/개별공시지가 기준년도 설정 셀위치(A4)
Dim stdrYearValue As Variant
stdrYearValue = Range("A4").Value
If Not IsNumeric(stdrYearValue) Or Len(stdrYearValue) <> 4 Then
MsgBox "토지특성정보/개별공시지가 조회할 기준년도(숫자 4자리)를 입력하세요."
Exit Sub
End If
' pnu가 있는 A열의 범위 설정 (A6부터 시작)
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 rowOffset As Long
Dim pnuSingleValue As String
Dim encodedKeyword As String
Dim URL(1 To 4) As String
Dim httpRequest As Object
Dim xmlResponse(1 To 4) As String
Dim xDoc(1 To 4) As MSXML2.DOMDocument60
Dim errNode(1 To 4) As MSXML2.IXMLDOMNode
Dim errCode(1 To 4) As String
Dim i As Long
Dim j As Long
Dim totalCount(1 To 4) As Long
Dim xNode(1 To 4) As MSXML2.IXMLDOMNode
Dim xNodes4 As MSXML2.IXMLDOMNodeList
Dim mnnmSlno As String
Dim mainmnnmSlno As String
Dim submnnmSlno As String
Dim parts As Variant
Dim regstrSeCode As String
Dim prposAreaDstrcCodeNm(1 To 3) As String
Dim cnflcAt As Long
Dim prposAreaDstrcCodeNmValue As String
Dim dataArr() As Variant
Dim outputRange As Range
Dim lastRow As Long
Dim rowNumber As Long
Dim counter As Long
' 시작 시간 기록
startTime = Timer
' 셀 값을 지우고 셀 형식 변경
If argsNum = 1 Then
targetSheet.Range("C" & START_ROW & ":N" & START_ROW + MAX_ROWS).ClearContents
ElseIf argsNum = 2 Then
targetSheet.Range("O" & START_ROW & ":W" & START_ROW + MAX_ROWS).ClearContents
ElseIf argsNum = 3 Then
targetSheet.Range("X" & START_ROW & ":AB" & START_ROW + MAX_ROWS).ClearContents
ElseIf argsNum = 4 Then
targetSheet.Range("AC" & START_ROW & ":AF" & START_ROW + MAX_ROWS).ClearContents
ElseIf argsNum = 5 Then
targetSheet.Range("B" & START_ROW & ":AF" & START_ROW + MAX_ROWS).ClearContents
End If
targetSheet.Range("A" & START_ROW & ":A" & START_ROW + MAX_ROWS).NumberFormat = "@"
targetSheet.Range("B" & START_ROW & ":AF" & START_ROW + MAX_ROWS).NumberFormat = "General"
targetSheet.Range("E" & START_ROW & ":E" & START_ROW + MAX_ROWS).NumberFormat = "@"
targetSheet.Range("I" & START_ROW & ":I" & START_ROW + MAX_ROWS).NumberFormat = "#,###.0"
targetSheet.Range("N" & START_ROW & ":N" & START_ROW + MAX_ROWS).NumberFormat = "yyyy-mm-dd"
targetSheet.Range("W" & START_ROW & ":W" & START_ROW + MAX_ROWS).NumberFormat = "yyyy-mm-dd"
targetSheet.Range("Y" & START_ROW & ":Y" & START_ROW + MAX_ROWS).NumberFormat = "#,###"
targetSheet.Range("AA" & START_ROW & ":AB" & START_ROW + MAX_ROWS).NumberFormat = "yyyy-mm-dd"
' pnuRangeValue가 단일 셀인지 확인
pnuRangeValue = GetRangeValuesToArray(pnuRange)
' pnuRangeValue의 행 수를 기준으로 dataArr 배열의 크기를 조정
ReDim dataArr(1 To UBound(pnuRangeValue, 1), 1 To 30)
' XMLHTTP 요청을 생성
Set httpRequest = CreateObject("MSXML2.XMLHTTP")
' pnuRangeValue의 각 항목에 대해 반복
For rowOffset = 1 To UBound(pnuRangeValue, 1)
pnuSingleValue = pnuRangeValue(rowOffset, 1)
' 토지이용계획정보 조회 특정 키워드값에 sql키워드 및 특수문자 포함시 제거 후 utf-8로 인코딩
If argsNum = 4 Or argsNum = 5 Then
If searchPrposAreaDstrcValue <> vbNullString Then
searchPrposAreaDstrcValue = rmSQLKeywordsAndSpecialChars(searchPrposAreaDstrcValue)
encodedKeyword = encodeURL(searchPrposAreaDstrcValue, True)
End If
End If
' URLs 빌드
' URL1 : 토지임야정보 조회(https://www.data.go.kr/data/15057917/openapi.do)
' URL2 : 토지특성정보 조회(https://www.data.go.kr/data/15057558/openapi.do)
' URL3 : 개별공사지가 조회(https://www.data.go.kr/data/15059127/openapi.do)
' URL4 : 토지이용계획 조회(https://www.data.go.kr/data/15056930/openapi.do)
URL(1) = "https://apis.data.go.kr/1611000/nsdi/eios/LadfrlService/ladfrlList.xml?&format=xml&serviceKey=" & serviceKey & "&pnu=" & pnuSingleValue
URL(2) = "https://apis.data.go.kr/1611000/nsdi/LandCharacteristicsService/attr/getLandCharacteristics?&format=xml&serviceKey=" & serviceKey & "&pnu=" & pnuSingleValue & "&stdrYear=" & stdrYearValue
URL(3) = "https://apis.data.go.kr/1611000/nsdi/IndvdLandPriceService/attr/getIndvdLandPriceAttr?&format=xml&serviceKey=" & serviceKey & "&pnu=" & pnuSingleValue & "&stdrYear=" & stdrYearValue
URL(4) = "https://apis.data.go.kr/1611000/nsdi/LandUseService/attr/getLandUseAttr?&numOfRows=200&format=xml&serviceKey=" & serviceKey & "&pnu=" & pnuSingleValue & "&prposAreaDstrcCodeNm=" & encodedKeyword
If argsNum = 5 Then
For i = 1 To 4
' GET 요청을 보내고 XML 응답을 받기
xmlResponse(i) = SendRequest(httpRequest, URL(i))
' XML 응답을 XML 문서로 로드
Set xDoc(i) = New MSXML2.DOMDocument60
xDoc(i).LoadXML xmlResponse(i)
' 오류를 위한 XML 응답 파싱
Set errNode(i) = xDoc(i).SelectSingleNode("/OpenAPI_ServiceResponse/cmmMsgHeader/returnReasonCode")
If Not errNode(i) Is Nothing Then
errCode(i) = errNode(i).Text
End If
Next i
Else
xmlResponse(argsNum) = SendRequest(httpRequest, URL(argsNum))
Set xDoc(argsNum) = New MSXML2.DOMDocument60
xDoc(argsNum).LoadXML xmlResponse(argsNum)
Set errNode(argsNum) = xDoc(argsNum).SelectSingleNode("/OpenAPI_ServiceResponse/cmmMsgHeader/returnReasonCode")
If Not errNode(argsNum) Is Nothing Then
errCode(argsNum) = errNode(argsNum).Text
End If
End If
If argsNum = 1 Or argsNum = 5 Then
' URL(1)에 에러가 있으면 에러코드를 dataArr에 저장
If errCode(1) <> vbNullString Then
dataArr(rowOffset, 1) = errCode(1)
Else
' URL(1)에 에러코드 없으면 에러코드로 0을 dataArr에 저장
dataArr(rowOffset, 1) = 0
' URL(1)의 XML 응답 데이터 갯수 확인
totalCount(1) = xDoc(1).SelectSingleNode("/fields/totalCount").Text
If totalCount(1) = 1 Then
' URL(1)의 XML 응답 파싱
Set xNode(1) = xDoc(1).SelectSingleNode("/fields/ladfrlVOList")
mnnmSlno = xNode(1).SelectSingleNode("mnnmSlno").Text
' 혹시 있을지 모를 모든 공백을 제거
mnnmSlno = Replace(mnnmSlno, " ", vbNullString)
' 지번을 본번,부번으로 분할
If InStr(mnnmSlno, "-") > 0 Then
' mnnmSlno를 mainmnnmSlno와 submnnmSlno로 분할
parts = Split(mnnmSlno, "-")
' "-" 좌우의 값을 저장
mainmnnmSlno = parts(0)
submnnmSlno = parts(1)
Else
' "-"이 발견되지 않으면 mnnmSlno 전체를 mainmnnmSlno에 할당
mainmnnmSlno = mnnmSlno
End If
' 지번에서 부번이 없는경우 "-0"을 제거
If Right$(mnnmSlno, 2) = "-0" Then
mnnmSlno = Left$(mnnmSlno, Len(mnnmSlno) - 2)
End If
' regstrSeCode의 값을 확인 후 값이 "2"이면 지번과 본번 앞에"산"덧붙이기
regstrSeCode = xNode(1).SelectSingleNode("regstrSeCode").Text
If regstrSeCode = "2" Then
mnnmSlno = "산" & mnnmSlno
mainmnnmSlno = "산" & mainmnnmSlno
End If
' dataArr에 저장
dataArr(rowOffset, 2) = xNode(1).SelectSingleNode("ldCodeNm").Text
dataArr(rowOffset, 3) = mnnmSlno
dataArr(rowOffset, 4) = mainmnnmSlno
dataArr(rowOffset, 5) = submnnmSlno
dataArr(rowOffset, 6) = xNode(1).SelectSingleNode("lndcgrCodeNm").Text
dataArr(rowOffset, 7) = xNode(1).SelectSingleNode("lndpclAr").Text
dataArr(rowOffset, 8) = xNode(1).SelectSingleNode("regstrSeCodeNm").Text
dataArr(rowOffset, 9) = xNode(1).SelectSingleNode("posesnSeCodeNm").Text
dataArr(rowOffset, 10) = xNode(1).SelectSingleNode("cnrsPsnCo").Text
dataArr(rowOffset, 11) = "'" & xNode(1).SelectSingleNode("ladFrtlScNm").Text
dataArr(rowOffset, 12) = xNode(1).SelectSingleNode("lastUpdtDt").Text
End If
End If
End If
If argsNum = 2 Or argsNum = 5 Then
' URL(2)에 에러가 있으면 에러코드를 dataArr에 저장
If errCode(2) <> vbNullString Then
dataArr(rowOffset, 13) = errCode(2)
Else
' URL(2)에 에러코드 없으면 에러코드로 0을 dataArr에 저장
dataArr(rowOffset, 13) = 0
' URL(2)의 XML 응답 데이터 갯수 확인
totalCount(2) = xDoc(2).SelectSingleNode("/response/totalCount").Text
If totalCount(2) = 1 Then
' URL(2)의 XML 응답 파싱
Set xNode(2) = xDoc(2).SelectSingleNode("/response/fields/field")
' dataArr에 저장
dataArr(rowOffset, 14) = xNode(2).SelectSingleNode("prposArea1Nm").Text
dataArr(rowOffset, 15) = xNode(2).SelectSingleNode("prposArea2Nm").Text
dataArr(rowOffset, 16) = xNode(2).SelectSingleNode("ladUseSittnNm").Text
dataArr(rowOffset, 17) = xNode(2).SelectSingleNode("tpgrphHgCodeNm").Text
dataArr(rowOffset, 18) = xNode(2).SelectSingleNode("tpgrphFrmCodeNm").Text
dataArr(rowOffset, 19) = xNode(2).SelectSingleNode("roadSideCodeNm").Text
dataArr(rowOffset, 20) = xNode(2).SelectSingleNode("stdrYear").Text
dataArr(rowOffset, 21) = xNode(2).SelectSingleNode("lastUpdtDt").Text
End If
End If
End If
If argsNum = 3 Or argsNum = 5 Then
' URL(3)에 에러가 있으면 에러코드를 dataArr에 저장
If errCode(3) <> vbNullString Then
dataArr(rowOffset, 22) = errCode(3)
Else
' URL(3)에 에러코드 없으면 에러코드로 0을 dataArr에 저장
dataArr(rowOffset, 22) = 0
' URL(3)의 XML 응답 데이터 갯수 확인
totalCount(3) = xDoc(3).SelectSingleNode("/response/totalCount").Text
If totalCount(3) = 1 Then
' URL(3)의 XML 응답 파싱
Set xNode(3) = xDoc(3).SelectSingleNode("/response/fields/field")
' dataArr에 저장
dataArr(rowOffset, 23) = xNode(3).SelectSingleNode("pblntfPclnd").Text
dataArr(rowOffset, 24) = xNode(3).SelectSingleNode("stdrYear").Text
dataArr(rowOffset, 25) = xNode(3).SelectSingleNode("pblntfDe").Text
dataArr(rowOffset, 26) = xNode(3).SelectSingleNode("lastUpdtDt").Text
End If
End If
End If
If argsNum = 4 Or argsNum = 5 Then
' URL(4)에 에러가 있으면 에러코드를 dataArr에 저장
If errCode(4) <> vbNullString Then
dataArr(rowOffset, 27) = errCode(4)
Else
' URL(4)에 에러코드 없으면 에러코드로 0을 dataArr에 저장
dataArr(rowOffset, 27) = 0
' URL(4)의 XML 응답 데이터 갯수 확인
totalCount(4) = xDoc(4).SelectSingleNode("/response/totalCount").Text
If totalCount(4) > 0 Then
' URL(4)의 XML 응답 파싱
Set xNodes4 = xDoc(4).SelectNodes("/response/fields/field")
' xNodes4 컬렉션에서 노드를 반복하면서 cnflcAt 값(범위 1~3)을 기준으로 prposAreaDstrcCodeNm 변수에 값을 추가
For Each xNode(4) In xNodes4
cnflcAt = xNode(4).SelectSingleNode("cnflcAt").Text
prposAreaDstrcCodeNmValue = xNode(4).SelectSingleNode("prposAreaDstrcCodeNm").Text
prposAreaDstrcCodeNm(cnflcAt) = prposAreaDstrcCodeNm(cnflcAt) & prposAreaDstrcCodeNmValue & ", "
Next
For i = 1 To 3
If Len(prposAreaDstrcCodeNm(i)) > 0 Then
' 마지막 쉼표와 공백 제거
prposAreaDstrcCodeNm(i) = RemoveDuplicates(prposAreaDstrcCodeNm(i))
prposAreaDstrcCodeNm(i) = Left$(prposAreaDstrcCodeNm(i), Len(prposAreaDstrcCodeNm(i)) - 2)
' cnflcAtValue 값에 따라 dataArr의 열 27+j에 저장
dataArr(rowOffset, 27 + i) = prposAreaDstrcCodeNm(i)
' 다음 반복을 위해 prposAreaDstrcCodeNm 변수 초기화
prposAreaDstrcCodeNm(i) = vbNullString
End If
Next i
End If
End If
End If
Next rowOffset
' 워크시트에 dataArr 데이터 쓰기
If argsNum = 1 Then
Set outputRange = targetSheet.Range("C" & START_ROW).Resize(rowOffset - 1, 12)
' dataArr 배열의 1번째 열부터 12번째 열까지만 해당 범위에 출력
For i = 1 To outputRange.Rows.Count
For j = 1 To 12
outputRange.Cells(i, j).Value = dataArr(i, j)
Next j
Next i
ElseIf argsNum = 2 Then
Set outputRange = targetSheet.Range("O" & START_ROW).Resize(rowOffset - 1, 9)
' dataArr 배열의 13번째 열부터 21번째 열까지만 해당 범위에 출력
For i = 1 To outputRange.Rows.Count
For j = 13 To 21
outputRange.Cells(i, j - 12).Value = dataArr(i, j)
Next j
Next i
ElseIf argsNum = 3 Then
Set outputRange = targetSheet.Range("X" & START_ROW).Resize(rowOffset - 1, 5)
' dataArr 배열의 22번째 열부터 26번째 열까지만 해당 범위에 출력
For i = 1 To outputRange.Rows.Count
For j = 22 To 26
outputRange.Cells(i, j - 21).Value = dataArr(i, j)
Next j
Next i
ElseIf argsNum = 4 Then
Set outputRange = targetSheet.Range("AC" & START_ROW).Resize(rowOffset - 1, 4)
' dataArr 배열의 27번째 열부터 30번째 열까지만 해당 범위에 출력
For i = 1 To outputRange.Rows.Count
For j = 27 To 30
outputRange.Cells(i, j - 26).Value = dataArr(i, j)
Next j
Next i
ElseIf argsNum = 5 Then
targetSheet.Range("C" & START_ROW).Resize(rowOffset - 1, 30).Value = dataArr
End If
' B열에 행번호 매기기
lastRow = targetSheet.Cells.item(targetSheet.Rows.Count, "A").End(xlUp).Row
counter = 1
For rowNumber = START_ROW To lastRow
If Not IsEmpty(targetSheet.Cells.item(rowNumber, "A")) Then
targetSheet.Cells.item(rowNumber, "B").Value = counter
counter = counter + 1
End If
Next rowNumber
' 데이터 조회완료 후 집계하기(aggrSheet에 출력, 일괄실행시에만 실행)
' --------------------------------------------------------------------------
If argsNum = 5 Then
' 집계 대상 및 항목 설정
Dim targetColumn As Long
Dim itemColumn() As String
Dim itemTitle() As String
targetColumn = 7 'dataArr 집계대상에 해당하는 열번호(면적)
itemColumn = Split("2,6,9,10,14,15,16,17", ",") 'dataArr 집계항목에 해당하는 열번호(법정동,지목, 소유구분, 소유(공유)인수, 용도지역1, 용도지역2, 토지이용상황, 지형높이)
itemTitle = Split("법정동,지목,소유구분,소유(공유)인수,용도지역1,용도지역2,토지이용상황,지형높이", ",")
Dim item As Long
Dim aggregateTable() As Variant
rowOffset = 2 ' 출력할 위치(행)
' aggrSheet 셀 기존값을 지우기
aggrSheet.Range("A" & rowOffset & ":C" & MAX_ROWS).ClearContents
If UBound(itemColumn) = UBound(itemTitle) Then
For item = LBound(itemColumn) To UBound(itemColumn)
aggregateTable = aggregate(dataArr, targetColumn, CLng(itemColumn(item)))
' 집계항목 타이틀 및 집계한 배열 데이터 출력범위 설정(aggrSheet 시트)
Set outputRange = aggrSheet.Range("A" & rowOffset)
outputRange.Value = itemTitle(item)
outputRange.Offset(1, 0).Resize(UBound(aggregateTable, 1), UBound(aggregateTable, 2)).Value = aggregateTable
rowOffset = rowOffset + UBound(aggregateTable, 1) + 3 ' 다음 결과를 출력할 행 간격 조정(2행 아래)
Next item
Else
MsgBox "집계항목의 열과 타이틀의 갯수가 일치하지 않습니다. 코드를 확인하세요."
End If
End If
' --------------------------------------------------------------------------
' 종료 시간 기록
endTime = Timer
executionTime = endTime - startTime
' 완료 메세지 표시
MsgBox "데이터 조회가 완료되었습니다." & vbCrLf & "총 실행시간 : " & executionTime & "초"
' 헤더 행 포맷 설정 및 열 자동 맞춤
targetSheet.Range("A" & START_ROW - 1 & ":AF" & START_ROW - 1).HorizontalAlignment = xlCenter
targetSheet.Columns.item("A:AF").AutoFit
aggrSheet.Columns.item("A:C").AutoFit
Exit Sub
ErrorHandler:
MsgBox "오류 발생: " & Err.Description
' 정리 작업
Set httpRequest = Nothing
Exit Sub
End Sub
Private Function aggregate(ByRef dataArray() As Variant, ByRef targetColumn As Long, ByRef itemColumn As Long) As Variant()
Dim itemCounts As Object ' 아이템별 개수를 저장
Dim itemSums As Object ' 아이템별 합계를 저장
Dim result() As Variant ' 결과를 저장할 배열
Dim i As Long
Set itemCounts = CreateObject("Scripting.Dictionary")
Set itemSums = CreateObject("Scripting.Dictionary")
Dim item As Variant
For i = LBound(dataArray, 1) To UBound(dataArray, 1)
item = dataArray(i, itemColumn)
' 아이템별 개수와 합계 갱신
If Not itemCounts.Exists(item) Then
itemCounts(item) = 1
itemSums(item) = CDbl(dataArray(i, targetColumn))
Else
itemCounts(item) = itemCounts(item) + 1
itemSums(item) = itemSums(item) + CDbl(dataArray(i, targetColumn))
End If
Next i
Dim itemCount As Long
Dim itemSum As Double
Dim index As Long
ReDim result(1 To itemCounts.Count, 1 To 3)
index = 1
' 결과 배열에 아이템, 합계, 개수를 저장
For Each item In itemCounts.Keys
itemCount = itemCounts(item)
itemSum = itemSums(item)
result(index, 1) = item
result(index, 2) = itemSum
result(index, 3) = itemCount
index = index + 1
Next item
aggregate = result
End Function
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
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), vbNullString, 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 SendRequest(ByRef httpRequest As Object, ByRef URL As String) As String
httpRequest.Open "GET", URL, False
httpRequest.send
SendRequest = httpRequest.responseText
End Function
Private Function RemoveDuplicates(ByRef inputString As String) As String
Dim result As String
Dim values() As String
Dim i As Long
values = Split(inputString, ", ")
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
For i = LBound(values) To UBound(values)
dict(Trim$(values(i))) = 1
Next i
result = Join(dict.Keys, ", ")
RemoveDuplicates = result
End Function
Public Sub button1_click()
argsNum = 1
GetDataFromAPI argsNum
End Sub
Public Sub button2_click()
argsNum = 2
GetDataFromAPI argsNum
End Sub
Public Sub button3_click()
argsNum = 3
GetDataFromAPI argsNum
End Sub
Public Sub button4_click()
argsNum = 4
GetDataFromAPI argsNum
End Sub
Public Sub button5_click()
argsNum = 5
GetDataFromAPI argsNum
End Sub
안녕하세요 필요한 정보였는데 올려주셔서 감사합니다!
근데 올려주신 파일을 다운로드하고 열어서 연결할 프로그램 설정하려고 하니 계속 거기서 멈추는데 어떻게 해야할까요?
안녕하세요.
거기가 어디일까요.ㅜㅜ
보다 구체적인 상황과 증상을 말씀해주셔야...
안녕하세요. 이제 파이썬 프로그램 배운지 2주된 초보입니다. 파이썬 프로그램에 조금 흥미가 생겨서 주소가 들어있는 엑셀파일에서 토지이음정보를 가져오고 싶은데 기본정보를 토지이음 홈페이지('http://www.eum.go.kr/web/am/amMain.jsp')에서 파이썬 프로그램으로 가져오면 혹시 무슨 문제가 있는건가요? 프로그램을 사용할 경우에는 공공포털을 사용해야만 하나요? 너무 기본적인 질문이라 미안합니다.
안녕하세요.
토지이음, 공공데이터포털은 모두 국가에서 운영하는 곳으로
토지이음은 최신 토지관련 정보를 웹상으로 쉽게 확인할 수 있는 환경이지만 개방된 api는 제공하고 있지 않기에
데이터 획득하기 위해 웹페이지를 파싱해야 하므로 활용이 어렵습니다.
반면 공공데이터 포털은 다양한 공공데이터를 다운로드 혹은 개방된 api로 제공하기 때문에 json이나 xml을 파싱해서 사용자가 쉽게 활용할 수 있는 것이지요. 그러나 토지이음 만큼 토지정보가 최신은 아닌 단점이 있습니다.