作者chungyuandye (养花种鱼数月亮看星星)
看板Visual_Basic
标题Re: [VBA ] 请问如何整理拍卖网站上的id呢
时间Mon Mar 17 01:40:09 2008
※ 引述《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
1F：推 jameswiki:呵..利害..花时间帮原PO写出来了! 03/17 06:15
2F：推 yanli2:有了这些名单 又可以开始发广告信了~ 03/17 22:47
3F：推 forkome:请教一下WebTables这个值是对印什麽呢？找不到教学 03/20 00:09
4F：推 tang1019:chungyuandye大大厉害！ 03/22 13:50
5F：推 tang1019:WebTables可将该网页上指定编号的table抓下来 03/27 22:57