- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
16#
發表於 2014-11-18 16:40
| 只看該作者
本帖最後由 GBKEE 於 2014-11-18 16:50 編輯
回復 15# 518587
參考一下,選手姓名,年齡,身高,體重.可自己寫寫看
- Option Explicit
- Sub Ex()
- Dim n As Integer, myrng As Range, mySh As Worksheet, myAr
- '從網頁擷取資料
- For n = 1 To 2
- With Sheets("擷取資料")
- If .QueryTables.Count >= 1 Then .QueryTables("Novak-Djokovic_1").Delete '太多的QueryTable 物件會佔用資源
- .UsedRange.ClearContents
- Set myrng = Sheets("選手網址").Cells(n + 1, 1)
- Set mySh = Sheets("資料彙整")
- With .QueryTables.Add(Connection:="URL;" & myrng.Text, Destination:=.Range("$A$1"))
- .Name = "Novak-Djokovic_1"
- .FieldNames = True
- .RowNumbers = False
- .FillAdjacentFormulas = False
- .PreserveFormatting = True
- .RefreshOnFileOpen = False
- .BackgroundQuery = True
- .RefreshStyle = xlInsertDeleteCells
- .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
- Set myrng = .Cells.Find("W-L", Lookat:=xlWhole) '尋找"W-L"
- If Not myrng Is Nothing Then
- With .Cells(myrng.Row, "A")
- Select Case myrng.Column
- Case 3 '"W-L" 在C欄
- myAr = Array("", "", "", .Range("B3"), .Range("D2"), .Range("B4"), .Range("F2"), "", "", .Range("B6"), .Range("D5"), .Range("B7"))
- '單打排名(W-L):.Range("D2") -> 2014/3/6 這"(是3勝6敗)"在何處?
- Case 4 '"W-L" 在D欄
- myAr = Array(.Range("B3"), .Range("D2"), .Range("F6"), .Range("B5"), .Range("D4"), .Range("B6"), .Range("F4"), .Range("B8"), .Range("F7"), .Range("B10"), .Range("D9"), .Range("B11"))
- '雙打排名(W-L): .Range("D9") ->2014/6/27 這"(是6勝27敗)"在何處?
- End Select
- End With
- With Sheets("資料彙整").Cells(n + 1, "I").Resize(, UBound(myAr) + 1)
- .Value = myAr
- .Cells(IIf(myrng.Column = 4, 11, 5)).NumberFormatLocal = "yyyy/m/d"
-
- End With
- End If
- End With
- Next n
- ActiveWorkbook.Save
- MsgBox "處理完畢!"
- End Sub
|
|
發表於 2014-11-17 23:37
| 
