Re: [VBA ] 請問如何整理拍賣網站上的id呢
看板Visual_Basic作者chungyuandye (養花種魚數月亮看星星)時間16年前 (2008/03/17 01:40)推噓5(5推 0噓 0→)留言5則, 4人參與討論串2/2 (看更多)
※ 引述《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
推
03/17 06:15, , 1F
03/17 06:15, 1F
推
03/17 22:47, , 2F
03/17 22:47, 2F
推
03/20 00:09, , 3F
03/20 00:09, 3F
推
03/22 13:50, , 4F
03/22 13:50, 4F
推
03/27 22:57, , 5F
03/27 22:57, 5F
討論串 (同標題文章)
本文引述了以下文章的的內容：
完整討論串 (本文為第 2 之 2 篇)：