데이터>웹

'http://kin.naver.com/qna/detail.nhn?d1id=1&dirId=102020101&docId=279881907


'http://sports.news.naver.com/kbaseball/record/index.nhn?category=kbo&year=2017&type=batter&playerOrder=hra
'위이 사이트는 네이버에서 프로야구 선수(투수 및 타자)의 기록순위가 나오는 사이트 입니다.
'(* 화면 우측 상단의 '장타율' 옆의 붉은 박스 안의 화살표를 클릭하면 OPS,..., WAR 등의 순위도 나옵니다.)
'투수와 타자의 모든 순위 데이터를 서식없이 텍스트로만 가지고 오는 웹쿼리를 VBA로 구현하고 싶습니다. 서점에서 아무리 책을 찾아봐도 웹쿼리에 대해 자세히 나온 책이 없더군요.
'코드와 함께 간단한 주석도 첨부해 주시면 스스로 공부해 보겠습니다.
'시간들여서 너무 정성껏 만들지 않으셔도 됩니다. 전체적인 흐름만 알수 있으면 됩니다.
'무례한 부탁인 줄 아오나 가르침 기다리고 있겠습니다.




'2016버전이상에서 실행하세요.
'데이터>웹 메뉴의 매크로입니다.
'
'source by 땡큐엑셀vba & 엑셀매크로
'
Sub 매크로1()
'
' 매크로1 매크로
'

'

    '웹쿼리
    쿼리명 = "타자 순위" & Sheets.Count
    
    ActiveWorkbook.Queries.Add Name:=쿼리명, Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    원본 = Web.Page(Web.Contents(""http://sports.news.naver.com/kbaseball/record/index.nhn?category=kbo&year=2017&type=batter&playerOrder=hra""))," & Chr(13) & "" & Chr(10) & "    Data4 = 원본{4}[Data]," & Chr(13) & "" & Chr(10) & "    #""변경된 유형"" = Table.TransformColumnTypes(Data4,{{""순위"", Int64.Type}, {""선수"", type text}, {""타율"", type number}, {""경기수"", Int64.Type}, {""타수"", Int64.Type}, {""안타"", Int64.Type}, {""2루타" & _
        """, Int64.Type}, {""3루타"", Int64.Type}, {""홈런"", Int64.Type}, {""타점"", Int64.Type}, {""득점"", Int64.Type}, {""도루"", Int64.Type}, {""볼넷"", Int64.Type}, {""삼진"", Int64.Type}, {""출루율"", type number}, {""장타율"", type number}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""변경된 유형"""
        
    '시트추가
    ActiveWorkbook.Worksheets.Add
    
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""" & 쿼리명 & """" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [" & 쿼리명 & "]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "타자_순위" & Sheets.Count
        .Refresh BackgroundQuery:=False
    End With
    
    MsgBox "완료되었습니다", vbInformation, "땡큐엑셀vba & 엑셀매크로"
End Sub