推 jameswiki:呵..利害..花時間幫原PO寫出來了! 03/17 06:15
推 yanli2:有了這些名單 又可以開始發廣告信了~ 03/17 22:47
推 forkome:請教一下WebTables這個值是對印什麼呢？找不到教學 03/20 00:09
推 tang1019:chungyuandye大大厲害！ 03/22 13:50
推 tang1019:WebTables可將該網頁上指定編號的table抓下來 03/27 22:57
※ 引述《NEWSPP2001 (超喜歡唱歌)》之銘言：
: http://tw.user.bid.yahoo.com/tw/show/rating?userID=nardi7225&pageNo=2&filter=0
: 在這一頁拍賣評價網頁上
: 有很多買家的帳號
: 想請問有沒有什麼比較快的方法可以一次複製整理起來
: 因為目前只能想到一個一個複製 冏
: 感謝
: 回mail或是水球都可以
Sub Yahoo()
Dim Fn As Object
Set Fn = Application.WorksheetFunction
yahooid = "nardi7225"
endpage = 10
Index1 = 0
For i = 1 To endpage
Range("A" & i + Index1).Select
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://tw.user.bid.yahoo.com/tw/show/rating?userID=" & yahooid & "&pageNo=" & i & "&filter=0" _
, Destination:=Range("A" & i + Index1))
.FieldNames = False
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "10,12,14,16,18,20,22,24,26,28,30,32,34,36,38,40,42,44,46,48,51"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Index1 = Index1 + 39
Next
Range("A:B").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("B1") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
end_row = endpage * 20
For i = 1 To end_row
x = Fn.Find("給", Cells(i, 2), 1)
Cells(i, 3) = Mid(Cells(i, 2), 3, x - 3)
Next
Range("A:B").Delete
End Sub
寫得不好，但是可以抓～～Orz
--
※ 發信站: 批踢踢實業坊(ptt.cc)
◆ From: 118.232.189.101