[심화방] VBA_심화_100제 #4 [ 네이버 박스오피스 ]

 

엑사남님 강의중 유일하게 답을 못했던 문제!!

https://www.youtube.com/watch?v=cfvdrRKZ-N8 

 

이 웹페이지의 구성을 보면 div.item 밑으로 두개의 div태그가 있다.

thumb 이름에서 알수있듯이 썸네일이 있고 / title_box 에는 해당 영화제목이 있다.

콘솔창에 보자

div.item 자식 태그의 Img태그의 src 속성값을 가져오면 포스터를 가져올 수 있고

div.item의 text 를 가져오면 영화제목과 기타 텍스트 값을 가져올 수 있을 것이다.

 

네이버 박스오피스가 15개 영화만 보여지기 때문에 그것에 대한 조건문을 추가하면 별 어려움없이 박스오피스의 내용을 가져올 수 있을 것이다.

If Cnt = 15 Then Sel.FindElementByCss(".pg_next").Click   '= 순위 15-30 를 구하기 위한 다음 페이지 버튼
            
    If Cnt Mod 10 = 0 Then
        Set rngX = rngX.Offset(4, -9)                         '= 10개 단위로 반복
    Else
        Set rngX = rngX.Offset(, 1)                           '= 한줄 아래로 이동
    End If
        
If Cnt >= 30 Then Exit For                                '= Cnt >= 30 보다 크면 For문 종료

 

Sub 박스오피스()

    Dim Sel As New Selenium.WebDriver
    Dim strurl$, thumb$
    Dim Vtemp
    Dim rngX As Range: Set rngX = [b2]
    Dim Nodes As Object
    Dim Obj As Object
    Dim rngall As Range: Set rngall = [b1:k12]
    Dim Cnt&
    
    Haja_Format rngall                                                 '= 초기화

    Application.ScreenUpdating = False
        strurl = "https://search.naver.com/search.naver?where=nexearch&query=%EB%B0%95%EC%8A%A4%EC%98%A4%ED%94%BC%EC%8A%A4"

         Sel.AddArgument "--headless"                                  '= 헤드리스 모드
         Sel.Start "chrome"                                            '= 크롬으로 진행
         Sel.Get strurl
         
         
         Set Nodes = Sel.FindElementsByCss("#main_pack div.item")      '= 박스오피스 태그 영역을 Nodes로 재 설정해라

         For Each Obj In Nodes                                         '= 순환해라
     
            Vtemp = Split(Obj.Text, Chr(10))                           '= 영화 순위 / 제목  / 관객수를 임시배열에 담아라
            
            Cnt = CLng(Vtemp(0))
            rngX(0, 1) = Cnt                                           '= 영화순위를 넣어라
       
            thumb = Obj.FindElementByCss("div > img").Attribute("src") '= 영화 포스터 태그
            ActiveSheet.Shapes.AddPicture thumb, False, True, rngX.Left, rngX.Top, rngX.Width, rngX.Height + 2
            
            rngX(2, 1) = Vtemp(1): rngX(3, 1) = Vtemp(2)              '= 영화 제목과 관객수 출력
                                                                      
            If Cnt = 15 Then Sel.FindElementByCss(".pg_next").Click   '= 순위 15-30 를 구하기 위한 다음 페이지 버튼
            
            If Cnt Mod 10 = 0 Then
                Set rngX = rngX.Offset(4, -9)                         '= 10개 단위로 반복
            Else
                Set rngX = rngX.Offset(, 1)                           '= 한줄 아래로 이동
            End If
            
            If Cnt >= 30 Then Exit For                                '= Cnt >= 30 보다 크면 For문 종료
         
         Next Obj
         
            
    Application.ScreenUpdating = True
    
    MsgBox "박스오피스 출력을 완료했습니다."
         
End Sub

Function Haja_Format(rngall As Range)

    Dim sh As Shape
    
    For Each sh In ActiveSheet.Shapes                                '= 매크로 버튼을 제외한 모든 이미지객체를 삭제해라
    
        If sh.Name <> "Button 1" Then sh.Delete
    
    Next sh

    rngall.WrapText = False                                          '= 셀에 맞춤
    rngall.ClearContents
    rngall.HorizontalAlignment = xlCenter
    rngall.Borders.LineStyle = 1

End Function

박스오피스.xlsm

2.49MB

 

솔직히 이 과제를 더 빨리 해결할 수 있었다. 하지만 나에게는 이걸 해결하면 안될 것 같은 ... 마치 새끼새가 어미새의 품을 떠나 둥지를 떠나야 할 것 같은 느낌이 들어 계속 쉼표로 남겨놓았던 과제이다. 이렇게까지 성장하게 해준 엑사남님 정말 감사합니다.

 

2023년 엑사남님이 드디어 유튜브 복귀를 준비하고 계신다.

좀 더 쉽고 좀 더 많은 사람들이 VBA를 즐길 수 있게 강의를 준비하고 계신다고 한다.

그 강의에는 본인이 처음에 밤을 새서 해결했던 과제의 답처럼 VBA를 시작하는 미래의 엑사남과 미래의 Haja, 미래의 뽀리너, 미래의 준빠를 위해 비어놓으려 한다. 

 

너무나 오래걸렸던 본인의 마지막 숙제를 제출하며....

2023.01.05

땡큐 엑사남!!