用VBA抓Yahoo拍賣買家的帳號

用VBA抓Yahoo拍賣買家的帳號，雖然我不知道做這個有什麼用。但是在PTT上倒是很多人有這個需要。無聊寫的VBA，程式碼如下：
抓yahoo拍賣買家的帳號

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
Tags: Excel

• 編輯文章
• 此文章網址
• 轉寄此文章
• 目前有0 意見