[發問] 如何從網頁抓取特定資料放進excel中

j88141

想請問~
因為最近需要輸入好幾千筆暢銷書的書名資料等
雖然以前有寫過VBA，
但是沒有寫過從網路抓取資料的經驗，
手動輸入300筆後，只好求助版上了...
謝謝大家願意幫忙。



附上網頁及excel檔
http://www.kingstone.com.tw/book/book_page.asp?kmcode=2018576734531&actid=ActBillBoard
web網路抓取特定資料.rar (6.06 KB)

下載次數: 6

2015-12-21 01:44

下載 (265.46 KB)

2015-12-21 01:40

joey0415

回復 1# j88141

金石堂太慢了！改用博客來！

找到網站請貼上網址即可

下載 (104.11 KB)

2015-12-23 10:04

博客來.zip (17.51 KB)

下載次數: 23

2015-12-23 10:04

j88141

回復 2# joey0415


原來還可以這樣寫
謝謝 joey0415

joey0415

回復 4# kaui700

1. Sub 博客來()
   
2. 
   
3.     X = InputBox("請輸入博客來網址：（速度較快）", "提示")
   
4. '    Application.ScreenUpdating = False
   
5. '        Cells.ClearContents
   
6.     Sheets("temp").Activate
   
7. 
   
8. 
   
9.     Cells.Delete
   
10.    
    
11.     surl = "URL;" & X
    
12. 
    
13.     With ActiveSheet.QueryTables.Add(Connection:=surl, Destination:=Range("$A$1"))
    
14.         .RefreshPeriod = 0
    
15.         .WebSelectionType = xlEntirePage
    
16.         .WebFormatting = xlWebFormattingNone
    
17.         .Refresh BackgroundQuery:=False
    
18.         .Delete
    
19.     End With
    
20.    
    
21.     finalrow = Cells(Rows.Count, 1).End(xlUp).Row
    
22.     fr = Sheets("整理").Cells(Rows.Count, 1).End(xlUp).Row + 1
    
23. '    Stop
    
24. '        s = 1
    
25.         For i = 1 To finalrow
    
26.             If Cells(i, 1) = "商品介紹" Then
    
27.                 Sheets("整理").Cells(fr, 1) = Cells(i + 1, 1)
    
28.             End If
    
29.             
    
30.             If Left(Cells(i, 1), 3) = "作者：" Then
    
31.                 Sheets("整理").Cells(fr, 2) = Trim(Replace(Replace(Cells(i, 1), "作者：", ""), "新功能介紹", ""))
    
32.             End If
    
33.             
    
34.             If Left(Cells(i, 1), 3) = "繪者：" Then
    
35.                 Sheets("整理").Cells(fr, 3) = Trim(Replace(Replace(Cells(i, 1), "繪者：", ""), "新功能介紹", ""))
    
36.             End If
    
37.             
    
38.             If Left(Cells(i, 1), 4) = "出版社：" Then
    
39.                 Sheets("整理").Cells(fr, 4) = Trim(Replace(Replace(Cells(i, 1), "出版社：", ""), "新功能介紹", ""))
    
40.             End If
    
41.             
    
42.             If Left(Cells(i, 1), 5) = "出版日期：" Then
    
43.                 Sheets("整理").Cells(fr, 5) = Trim(Replace(Replace(Cells(i, 1), "出版日期：", ""), "新功能介紹", ""))
    
44.             End If
    
45.         Next
    
46.         
    
47.         
    
48. Sheets("temp").Cells.Delete
    
49. 
    
50. Sheets("整理").Activate
    
51. End Sub

複製代碼

資料表名稱：temp  與   整理  才能執行