네이버부동산 크롤링 지역입력 문으 드립니다.

VBA
작성자
도깨비
작성일
2020-11-17 10:57
조회
116
앞전 답변 정말 감사드립니다. 타입 입력하는 작업은 영상보면서 열심히 해 보겠지만 지역은 말씀하신대로~

'대구시 달서구/ 대구시 남구/ 대구시 동구/ 대구시 북구/ 대구시 서구/ 대구시 수성구/ 대구시 달성군/

동구 각산동/ 서구 평리동... URL 디코더한 글씨 정확하게 입력해도 않되고 있는데.... 다른 방법이 없을까요?
전체 3

  • 2020-11-17 16:13
    채택된 답변

    안녕하세요?^^

    기존의 #2~#3 명령문 구간을 아래 명령문으로 바꿔보시길 바랍니다.

    '#########################################################
    ' 2. 네이버 부동산 지도 페이지 -> 받아온 위/경도, 그 외 변수로 검색
    '                                                -> 해당 지역 가용매물 목록의 상세 위/경도 추출
    
    
    URL = "https://m.land.naver.com/cluster/clusterList?view=actl&cortarNo=" & cortarNo & "&rletTpCd=" & searchType & "&tradTpCd=" & buildingType & _
                "&z=" & z & "&lat=" & lat & "&lon=" & lon & "&addon=COMPLEX&bAddon=COMPLEX&isOnlyIsale=false"
    
    Set htmlResult = Nothing
    Set htmlResult = GetHttp(URL)
    strResult = htmlResult.body.innerHTML
    
    Dim forceCOMPLEX As Boolean
    If InStr(1, strResult, "COMPLEX") > 0 Then strResult = Splitter(strResult, "COMPLEX"): forceCOMPLEX = True
    Dim v As Variant
    v = ParseJSON(strResult, "lgeo,lat,lon,count")
    
    '##########################################################
    ' 3. 네이버 부동산 매물페이지  -> 상세 위 경도로 매물 정보 검색
    '                                                -> 각 매물별 상세정보 추출
    ' 매물페이지는 페이지당 20개씩만 출력.. 그래서 추가 작업 필요!
    ' Set htmlResult = Nothing
    ' Set htmlResult = GetHttp(URL)
    '                strResult = htmlResult.body.innerHTML
    '                vReturn = ParseJSON(strResult, "hscpNm,hscpNo,scpTypeCd,hscpTypeNm,totDongCnt,totHsehCnt,genHsehCnt,useAprvYmd,repImgUrl,dealCnt,leaseCnt,rentCnt," & _
                                                 "strmRentCnt,totalAtclCnt,minSpc,maxSpc,dealPrcMin,dealPrcMax,leasePrcMin,leasePrcMax,isalePrcMin,isalePrcMax,isaleNotifSeq,isaleScheLabel,isaleScheLabelPre", city, ",")
    
    Dim i As Long: Dim iPage As Long: Dim j As Long
    Dim vReturn As Variant
    Dim x As Long: x = GetLastRow(Sheet1) + 1
    Dim initR As Long
    initR = x
    
    For i = LBound(v, 1) To UBound(v, 1)
        If v(i, 1) <> "" Then
            iPage = Application.WorksheetFunction.RoundUp(v(i, 4) / 20, 0)
            For j = 1 To iPage
            If forceCOMPLEX = False Then
                URL = "https://m.land.naver.com/cluster/ajax/articleList?itemId=" & v(i, 1) & "&lgeo=" & v(i, 1) & _
                                "&rletTpCd=" & searchType & "&tradTpCd=" & buildingType & "&z=" & z & "&lat=" & v(i, 2) & "&lon=" & v(i, 3) & "&cortarNo=" & cortarNo & _
                                "&isOnlyIsale=false&sort=readRank&page=" & j
                Debug.Print URL
                Set htmlResult = Nothing
                Set htmlResult = GetHttp(URL)
                strResult = htmlResult.body.innerHTML
                If InStr(1, strResult, "atclNo") > 0 Then
                    vReturn = ParseJSON(strResult, "atclNm,atclNo,tradTpCd,rletTpNm,totDongCnt_tmp,totHsehCnt_tmp,genHsehCnt_tmp,atclCfmYmd,repImgUrl,tradTpNm,flrInfo,atclTetrDesc," & _
                                    "strmRentCnt_tmp,totalAtclCnt_tmp,spc1,spc2,sameAddrMinPrc,sameAddrMaxPrc,minMviFee,maxMviFee,cpid,cpNm,rltrNm,isaleScheLabel_tmp,isaleScheLabelPre_tmp", city, ",")
                    ArrayToRng Sheet1.Cells(x, 4), vReturn
                    x = x + UBound(vReturn, 1)
                End If
            Else
                URL = "https://m.land.naver.com/cluster/ajax/complexList?itemId=" & v(i, 1) & "&lgeo=" & v(i, 1) & _
                        "&rletTpCd=" & searchType & "&tradTpCd=" & buildingType & "&z=" & z & "&lat=" & v(i, 2) & "&lon=" & v(i, 3) & "&cortarNo=" & cortarNo & "&isOnlyIsale=false&sort=readRank&page=" & j
                Set htmlResult = Nothing
                Set htmlResult = GetHttp(URL)
                strResult = htmlResult.body.innerHTML
                If InStr(1, strResult, "hscpNo") > 0 Then
                    vReturn = ParseJSON(strResult, "hscpNm,hscpNo,scpTypeCd,hscpTypeNm,totDongCnt,totHsehCnt,genHsehCnt,useAprvYmd,repImgUrl,dealCnt,leaseCnt,rentCnt," & _
                                    "strmRentCnt,totalAtclCnt,minSpc,maxSpc,dealPrcMin,dealPrcMax,leasePrcMin,leasePrcMax,isalePrcMin,isalePrcMax,isaleNotifSeq,isaleScheLabel,isaleScheLabelPre", city, ",")
                    ArrayToRng Sheet1.Cells(x, 4), vReturn
                    x = x + UBound(vReturn, 1)
                End If
            End If
            Next
        End If
    Next

    기존의 PARSEJSON 명령문도 아래 명령문으로 교체해주세요.

    Function ParseJSON(strJSON, strToParse, Optional strID, Optional strToRemove) As Variant
    
    '###############################################################
    '오빠두엑셀 VBA 사용자지정함수 (https://www.oppadu.com)
    '▶ ParseJSON 함수
    '▶ strJSON 데이터에서 선택한 데이터 값만 추출합니다.
    '▶ 인수 설명
    '_____________strJSON            : JSON 데이터입니다.
    '_____________strToParse        : JSON 추출할 데이터 필드명입니다. 쉼표(,)로 구분하여 입력합니다.
    '_____________strID                 : 추출한 데이터 배열의 열에 추가할 ID 입니다. (선택인수)
    '_____________strToRemove   : 추출한 데이터에서 제거할 문자열입니다. 쉼표(,)로 구분하여 입력합니다.
    '▶ 사용 예제
    'Dim v As Variant
    'v = ParseJSON(JsonData, "Date, Name, Item")
    '###############################################################
    
    '----------------------------------------------------
    '변수 설정
    '----------------------------------------------------
    Dim vaToParse As Variant: Dim vToParse As Variant
    Dim vaToRemove As Variant: Dim vToRemove As Variant
    Dim lngStart As Long
    Dim objItm As Variant: Dim strItm As String: Dim tmpItm As String
    Dim itmCnt As Long
    Dim i As Long: Dim r As Long: Dim c As Long
    Dim dicItm As Object
    Dim vaItm As Variant: Dim vaItems As Variant: Dim vaReturn As Variant
    Dim iCol As Long: Dim maxCol As Long: Dim j As Long
    
    Set dicItm = CreateObject("Scripting.Dictionary")
    
    '----------------------------------------------------
    'JSON 쿼리 분할
    '----------------------------------------------------
    vaToParse = Split(strToParse, ",")
    If Not IsMissing(strToRemove) Then vaToRemove = Split(strToRemove, ",")
    
    lngStart = InStr(1, strJSON, "[")
    strJSON = Right(strJSON, Len(strJSON) - lngStart)
    
    objItm = Split(strJSON, "{""")
    itmCnt = UBound(objItm)
    
    For i = 1 To itmCnt
        strItm = Split(objItm(i), """}")(0)
         iCol = Len(strItm) - Len(Replace(strItm, ":", ""))
        If iCol > maxCol Then maxCol = iCol
        
        If Not IsMissing(strID) Then
            ReDim vaItm(0 To iCol)
            vaItm(0) = strID: j = 1
        Else
            ReDim vaItm(0 To iCol - 1)
            j = 0
        End If
        
        On Error Resume Next
        For Each vToParse In vaToParse
            If InStr(strItm, Trim(vToParse) & """:") > 0 Then
                tmpItm = Split(strItm, Trim(vToParse) & """:")(1)
                tmpItm = Split(tmpItm, ",""")(0)
                If Left(tmpItm, 1) = """" Then tmpItm = Right(tmpItm, Len(tmpItm) - 1)
                If Right(tmpItm, 1) = """" Then tmpItm = Left(tmpItm, Len(tmpItm) - 1)
                tmpItm = Replace(tmpItm, "< ", "")
                If Not IsMissing(strToRemove) Then
                    For Each vToRemove In vaToRemove
                        tmpItm = Replace(tmpItm, Trim(vToRemove), "")
                    Next
                End If
                vaItm(j) = CStr(tmpItm)
            End If
            j = j + 1
        Next
        On Error GoTo 0
        dicItm.Add i, Array(vaItm, 1)
    Next
    
    '----------------------------------------------------
    'Dictionary -> 배열 변환
    '----------------------------------------------------
    r = dicItm.Count
    c = UBound(vaToParse) + 1
    If Not IsMissing(strID) Then c = c + 1
    
    If r = 0 Then ParseJSON = ""
    
    vaItems = dicItm.Items
    
    ReDim vaReturn(1 To r, 1 To c)
    
    On Error Resume Next
    For i = 0 To r - 1
        For j = 0 To c - 1
            tmpItm = vaItems(i)(0)(j)
            If IsNumeric(tmpItm) And Left(tmpItm, 1) <> 0 Then vaReturn(i + 1, j + 1) = CDbl(tmpItm) Else vaReturn(i + 1, j + 1) = tmpItm
        Next
    Next
    On Error GoTo 0
    
    '----------------------------------------------------
    '결과값 리턴
    '----------------------------------------------------
    ParseJSON = vaReturn
    
    End Function

    기본적으로 네이버는 대량의 데이터 추출시 해당 IP를 봇으로 감지하여 차단을 하고 있습니다.
    따라서 대구시 (시단위 조회), 달서구 (구단위 조회)시 봇으로 감지되어 일정기간 접속이 차단될 수 있다는 점을 주의해서 사용하셔야 합니다.^^

    위 명령문은 1시간 이상 내용을 살펴보며 구조를 확인한 뒤 수정하여 적어드린 내용입니다.
    작성자분께서 구현하고자 하는 정확한 크롤링 툴은 영상강의를 확인 후 명령문을 적절히 수정하며 구현해보시길 바랍니다.^^

    답변이 도움이 되셨길 바랍니다. 감사합니다.


    • 2020-11-17 16:36

      너무 감사드립니다.~~ 역시 제가 해결할 수 있는 수준이 아니었습니다.
      오바두~ 최고입니다..... 나머지는 제가 노력해서 열심히 해보겠습니다.


      • 2020-11-18 20:49

        웹크롤링의 진수를 보여주네요...

        파이썬에서도 응용해 볼 수 있겠네요..


        전체 1,556
        번호 카테고리제목작성자작성일추천조회
        1551 함수/공식
        New PDF로 저장할때 HYPERLINK 함수를 적용시킬수 있는 방법이 있을까요? 첨부파일
        찬우아빠 | 2020.11.25 | 추천 1 | 조회 19
        찬우아빠2020.11.25119
        1550 문서서식
        New 한글에서 표를 엑셀로 복사붙여넣기 할때요
        욕심없는성공v | 2020.11.25 | 추천 0 | 조회 18
        욕심없는성공v2020.11.25018
        1549 기능/도구
        New du-tool 삭제시 오류메세지 문의드립니다. 첨부파일
        좐킴 | 2020.11.25 | 추천 0 | 조회 10
        좐킴2020.11.25010
        1548 VBA
        New 이메일 본문에 차트 삽입
        달님 | 2020.11.25 | 추천 0 | 조회 10
        달님2020.11.25010
        1547 VBA
        New vba로 인터넷 창 전환 후 크기 변경 질문 드립니다.
        hyuk**** | 2020.11.25 | 추천 0 | 조회 15
        hyuk****2020.11.25015
        1546 기능/도구
        New 4개 기능 함수를 다운받아 설치 후 엑셀이 에러 창이 뜹니다. 첨부파일 (1)
        SM AD AMERICA | 2020.11.24 | 추천 0 | 조회 25
        SM AD AMERICA2020.11.24025
        1545 기능/도구
        New 엑셀 실행 시 에러 창이 뜹니다. 이거 해결할 수 있나요? 첨부파일 (1)
        SM AD AMERICA | 2020.11.24 | 추천 0 | 조회 16
        SM AD AMERICA2020.11.24016
        1544 차트/그래프
        New 주차별 꺾은선그래프 위에 증감수치 입력방법 (1)
        wjdxkdl**** | 2020.11.24 | 추천 0 | 조회 13
        wjdxkdl****2020.11.24013
        1543 문서서식
        New 아주 기초적인 질문이요.. (1)
        빨간돼지 | 2020.11.24 | 추천 0 | 조회 22
        빨간돼지2020.11.24022
        1542 VBA
        New 폴더 밑 하위 폴더 전체 이름을 반환하고 싶어요 도와주세요 (1)
        밍장군 | 2020.11.24 | 추천 0 | 조회 13
        밍장군2020.11.24013
        1541 차트/그래프
        New 주식형 차트에다가 보조축을 활용하고싶은데 방법을 모르겠습니다. (1) 답변완료
        김상호 | 2020.11.24 | 추천 0 | 조회 15
        김상호2020.11.24015
        1540 함수/공식
        New 엑셀 지도차트 만들기 transpose 배열함수 값 오류 뜹니다. (6)
        Yooon | 2020.11.24 | 추천 0 | 조회 35
        Yooon2020.11.24035
        1539 대시보드
        New 대시보드 관련 질문사항입니다. (4) 답변완료
        H.B | 2020.11.24 | 추천 2 | 조회 18
        H.B2020.11.24218
        1538 함수/공식
        New INDIRECT함수 관련 (2) 답변완료
        finebyme | 2020.11.24 | 추천 0 | 조회 29
        finebyme2020.11.24029
        1537 VBA
        New VBA 오픈 API 도와주세요 ㅜ (4)
        에너지뿜 | 2020.11.24 | 추천 0 | 조회 34
        에너지뿜2020.11.24034
        1536 문서서식
        New ~여러개 시트 하나로 연결 하는 문제 (1)
        생활지원센터 | 2020.11.23 | 추천 0 | 조회 42
        생활지원센터2020.11.23042
        1535 함수/공식
        New 정확하게 나올 수 없는건가요? 첨부파일 (2)
        공월 | 2020.11.23 | 추천 0 | 조회 27
        공월2020.11.23027
        1534 피벗테이블
        New 피벗테이블 비율 구했는데.. 값이 맞지가 않아요..ㅠㅠ 첨부파일 (2) 답변완료
        Lucy Kim | 2020.11.23 | 추천 0 | 조회 17
        Lucy Kim2020.11.23017
        1533 함수/공식
        New 날짜세는 엑셀 함수 첨부파일 (1)
        엑셀초보!!!!! | 2020.11.23 | 추천 0 | 조회 28
        엑셀초보!!!!!2020.11.23028
        1532 함수/공식
        전체 범위에서 여러 열에 입력되어 있는 특정값 추출하기.. 첨부파일 (1)
        현동전문가 | 2020.11.22 | 추천 0 | 조회 45
        현동전문가2020.11.22045
        1531 함수/공식
        원하는 정보 추출 엑셀 함수 (2)
        Jenny | 2020.11.22 | 추천 0 | 조회 46
        Jenny2020.11.22046
        1530 기능/도구
        행 일괄 추가(?) 문의드립니다. (2)
        웁웁 | 2020.11.22 | 추천 0 | 조회 40
        웁웁2020.11.22040
        1529 함수/공식
        도데체 어떻게 하는 좀 알려수세요 부탁드립니다 첨부파일 (2)
        acedo**** | 2020.11.21 | 추천 0 | 조회 63
        acedo****2020.11.21063
        1528 함수/공식
        엑셀 함수에 여러 범위 문자열 입력하여 계산하는 방법이 안풀립니다. 첨부파일 (3)
        회색자유 | 2020.11.21 | 추천 0 | 조회 28
        회색자유2020.11.21028
        1527 차트/그래프
        꺽은선형 그래프의 축 변경 첨부파일 (1)
        치즈쿠키 | 2020.11.21 | 추천 0 | 조회 34
        치즈쿠키2020.11.21034
        1526 함수/공식
        중복 값 데이터 찾기 문의 첨부파일 (1)
        혀니양님 | 2020.11.21 | 추천 0 | 조회 42
        혀니양님2020.11.21042
        1525 VBA
        다시 한번 더 질문드립니다. 피벗테이블의 값이 변화할 때마다 차트 데이터 범위를 메크로를 사용해서 자동으로 넣고싶습니다. 첨부파일 (4) 답변완료
        iviolin**** | 2020.11.20 | 추천 0 | 조회 43
        iviolin****2020.11.20043
        1524 문서서식
        연결된 그림에서 선이 두꺼워지는 현상 (2) 답변완료
        퉁퉁이 | 2020.11.20 | 추천 0 | 조회 25
        퉁퉁이2020.11.20025
        1523 문서서식
        엑셀 x 워드 메일머지 사용법 관련 질문이 있습니다. 첨부파일 (5) 답변완료
        niceyoon58 | 2020.11.20 | 추천 0 | 조회 23
        niceyoon582020.11.20023
        1522 피벗테이블
        피벗테이블 작성 시 텍스트 출력 및 항목중 가장 높은 순위(rank) 구현 가능 할까요? 첨부파일 (4)
        국화쌍피앵두대왕 | 2020.11.20 | 추천 0 | 조회 39
        국화쌍피앵두대왕2020.11.20039