Re: [算表]MLB球員資料--抓網頁資料,VBA

[JieJuen (David)]

http://mlb.im.tv/Stats_PlayerPit.asp?Teamid=146
                                            ^^^球隊id
不同球隊id不同 網址自然不同
經測試可用Excel讀(勾網頁最左上角的箭頭)

http://2y.drivehq.com/q/MLBStats.xls

可錄下巨集動作後修改成自己所要的

http://2y.drivehq.com/q/MLBStats2.xls

參考: 板上搜尋標題 /網頁

  2.  8. ◆ 重覆動作.批次.數字轉換-拒絕笨笨的一個一個做!
  2.  8. 13. ◆ 抓網頁資料
(精華區可能變動)


基本：

A1=146

Sub MLBStats()
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://mlb.im.tv/Stats_PlayerPit.asp?Teamid=" & [A1], _
         Destination:=Range("A4"))
        .Name = "Stats_PlayerPit.asp?Teamid=146"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
End Sub

自訂：

先依網頁原始碼資料剖析得出各隊id

配置如下

A                 B           C             D
美聯-AL 金鶯      美聯-AL     金鶯          110
美聯-AL 紅襪      美聯-AL     紅襪          111
美聯-AL 印地安人  美聯-AL     印地安人      114
美聯-AL 白襪      美聯-AL     白襪          145
美聯-AL 老虎      美聯-AL     老虎          116
美聯-AL 皇家      美聯-AL     皇家          118
美聯-AL 天使      美聯-AL     天使          108

(下略)
A欄  A3  =B3&" "&C3

定義
ID      =Sheet1!$E$2
Start   =Sheet1!$F$1
Team    =Sheet1!$A:$A

Sub MLBStats()

    On Error GoTo NewQuery
    With [Start].QueryTable
        .Connection = "URL;http://mlb.im.tv/Stats_PlayerPit.asp?Teamid=" & [ID]
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
Exit Sub
NewQuery:
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://mlb.im.tv/Stats_PlayerPit.asp?Teamid=" & [ID], _
        Destination:=[Start])
        .Name = "Stats_PlayerPit"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
End Sub

進一步功能
點到A欄即可更新資料

VBA 的Sheet1(上表所在工作表)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim IdTemp

    If Target.Rows.Count + Target.Columns.Count = 2 Then

        If Target.Column = [Team].Column Then
            IdTemp = Target.Offset(, 3)
            If Application.IsNumber(IdTemp) Then
                Application.EnableEvents = False
                [E1] = Target
                [ID] = IdTemp
                MLBStats
                Application.EnableEvents = True
            End If
        End If
    End If

End Sub


若要同時保留原基本功能
因[ID]格會被VBA更改
不能再用VLOOKUP (公式)

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim TeamTemp
    If Target.Rows.Count + Target.Columns.Count = 2 Then

        If Target = [E1] Then
            With Worksheets(1).Range("a:a")
                Set TeamTemp = .Find(What:=Target, LookIn:=xlValues, _
              LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, MatchByte:=False, SearchFormat:=False)
            End With
            [ID] = TeamTemp.Offset(, 3)
        End If

    End If
End Sub



※ 引述《wencia (rere)》之銘言：
: 標題: [算表]MLB球員資料
: 時間: Mon May 11 22:56:09 2009
:
: 軟體:excel
:
: 版本:2000(不常使用都沒換)
:
: 各位觀看我問題的人大家好,我有一個問題想請教各位
:
: 問題是我在mlb中文官方網頁取得外部資料放入表格中
: http://mlb.im.tv/Stats_PlayerPit.asp
: 但例如說投手有1062列但是隊伍都亂排
:
: 像是
: 球員     球隊 勝投 XX XX XX  XX  XX   XXXXXXX
: L Ayala  雙城 0 0 1 3 14.29 1.17 2.25 xxxxxxx
: J Nelson 光芒 0 1 1 1  4.26 2.57 0    xxxxxxx
: 球員     球隊 勝投 XX XX XX  XX  XX   XXXXXXX
: D Meyer  馬林魚 xxx xxx xxxxxxxxxxxxxxxxxxxxx
:
: 注意到嗎?隊伍都是亂跳
: =============================================
: 我需要都是同隊伍的資料
:
: 像是xxx馬林魚 xxxxxx DD SS XXXXX
:     bbb馬林魚 kkkkkk RR TT XXXXX
: =============================================
:
: 然後資料有幾萬筆
: 我不能一直打=XXX!$A$1...,一直參照到另外頁
: 因為光投手數據就有28項 1062*28=29736項資料
: 做完後大概什麼事都別做了,遑論打者比投手更多
:
: PS:之前查詢網站用了些方法,總是不得要領(對EXCEL很不熟)
:
: 不知道能否教導一下方法該如何簡略輸入資料
: 和使用哪些函數
:
: 謝謝各位的指教
:
: --
: ※ 發信站: 批踢踢實業坊(ptt.cc)
: ◆ From: 220.139.184.26
: 推 JieJuen:http://mlb.im.tv/Stats_PlayerPit.asp?Teamid=146         05/12 00:52
: → wencia:ㄜ..一直沒發現,不過隊伍不同網址都一樣 外部資料沒法判斷   05/12 01:26
: → wencia:只能看網頁,不能用excel看                                 05/12 01:27
: → wencia:還是要感謝一下1f,之前都沒注意到                          05/12 01:28


--
※ 發信站: 批踢踢實業坊(ptt.cc)
◆ From: 114.47.39.13
※ 編輯: JieJuen         來自: 114.47.39.13         (05/12 04:27)
推 wencia:謝謝喔
→ JieJuen:^^
※ 編輯: JieJuen         來自: 114.47.39.13         (05/13 22:52)