[VBA] 멜론 Top 100 ..야나두~~

멜론 top 100 차트에서 순위 앨범사진 노래제목 가수를 가져오는 크롤링을 해보자

 

크게보면 tbody안에 tr태그안에 우리가 구하려는 것들이 자리잡고 있는데 1위부터 50위는 lst50 / 51위 부터는 lst100으로 표기 되어 있어서 이에 대해 약간의 트릭이 필요하다.

Option Explicit

Sub 멜론_top_100()

    Dim strUrl$
    Dim rngX As Range: Set rngX = [a2]
    Dim Nodes As Object
    Dim Pic As Object
    Dim Shp As shape
    Dim ID$: ID = "#lst50"
    Dim Obj As Object
    Dim xmlHttp As Object: Set xmlHttp = CreateObject("msxml2.xmlhttp")
    Dim Html As Object: Set Html = CreateObject("HtmlFile")
    Dim i&, N&
    
    Application.ScreenUpdating = False
    
    For Each Shp In ActiveSheet.Shapes              '= 그림들을 순환
    
        If InStr(Shp.Name, "Picture") > 0 And Shp.Name <> "Picture 3022" Then Shp.Delete
       '= 체크박스는 제외하고 앨범 사진들만 지워라 / Picture 3022는 멜론 로고
        
    
    Next Shp
   
        strUrl = "https://www.melon.com/chart/"     '= 멜론 top 100 차트 url
        
            With xmlHttp
             
                 .Open "get", strUrl, False
                 .Send
                  Html.body.innerhtml = .responsetext
             
            End With
            
            Set Nodes = Html.GetElementsByTagName("tbody")(0)   '= QuerySelectorAll은 한 단계씩 이면 오류가 안나는데
                                                                '= 바로 실행하면 화면이 꺼지는 오류발생
            
            N = 1
            For Each Obj In Nodes.GetElementsByTagName("tr")    '= Tbody에서 tr태크를 순환해라
            
                If N > 50 Then ID = "#lst100"                   '= #lst50 / #lst100으로 구성되어 있음
                
                rngX = Obj.queryselector(ID & "> td:nth-child(2) > div > span.rank").innertext    '= 순위
             
                On Error Resume Next                                                              '= 앨범 썸네일
                
               ' Debug.Print Obj.queryselector(ID & "> td:nth-child(4) > div > a > img").getattribute("src")
                
                    Set Pic = ActiveSheet.Pictures.Insert(Obj.queryselector(ID & "> td:nth-child(4) > div > a > img").GetAttribute("src"))
                   '=  Url을 가져와서 시트에 삽입을 해라
                    
                    With Pic
                        .ShapeRange.LockAspectRatio = msoFalse                      '= 사진의 가로세로 고정비율 해제
                        .Top = rngX(1, 2).Top + 1
                        .Left = rngX(1, 2).Left + 1
                        .Width = rngX(1, 2).Width - 2
                        .Height = rngX(1, 2).Height - 2
                    End With
                    
                On Error GoTo 0
                
                rngX(1, 3) = Obj.queryselector(ID & " > td:nth-child(6) > div > div > div.ellipsis.rank01 > span > a").innertext  '= 제목
                rngX(1, 4) = Obj.queryselector(ID & " > td:nth-child(6) > div > div > div.ellipsis.rank02 > a").innertext         '= 가수
            
                Set rngX = rngX.Offset(1)                                           '= 바로 다음줄로 이동
                
                N = N + 1                                                           '= top 100 카운팅
                
            Next Obj
            
        Application.ScreenUpdating = True
        
        MsgBox "당신의 귀를 즐겁게 해줄 멜론 Top 100"
           
            
End Sub

Sub 체크박스_연결()

    Dim chkBox As Excel.CheckBox
    
    Const r& = 1
    Const c& = 1
    
    For Each chkBox In ActiveSheet.CheckBoxes
    
        With chkBox
            .LinkedCell = .TopLeftCell.Address
        End With
    
    Next

End Sub

콤보상자를 클릭하였을 시 노래가 재생되거나 정지된다.

 

이벤트를 사용하였기 때문에 콤보상자를 체크 또는 해제후 해당셀이 선택되어 있으면 다른셀을 클릭 후 해당셀을 클릭하여야 이벤트가 발생한다.

 

본 사진과는 다르게 수정된 코드는 노래가 바로 재생이 된다.

셀레니움으로 작동되기에 셀레니움은 필수이다.

https://www.youtube.com/watch?v=cfvdrRKZ-N8&t=1206s 

https://www.youtube.com/watch?v=a1z6_smslqM 

 

스트리밍 사이트이다.

http://pop.wimy.com/

WimyBox

 

멜론100.xlsm

0.08MB