標題: VBA抓取網站資料 [打印本頁]

---

作者: 52028    時間: 2015-4-30 05:10     標題: VBA抓取網站資料

各位大家好，我最近在練習VBA
我想要在按下 Button 可以有以下程式的功能
程式功能是OK的，但是抓取時間很久有時還會無回應
還有再變更抓取之週期時，會有抓到舊週期的資料的問題(但多按幾次會就會正常)
想問問我要從哪邊著手優化程式

[attach]20826[/attach]

1. Private Sub CommandButton2_Click()
   
2.     Range("A9:J168").Select
   
3.     ActiveWindow.SmallScroll Down:=-174
   
4.     Selection.ClearContents
   
5.     Selection.Clear
   
6.     Range("A8").Select
   
7.     '清除舊資料'
   
8.    
   
9. With ActiveSheet.QueryTables.Add(Connection:= _
   
10. "URL;http://www.cnyes.com/twstock/ps_historyprice.aspx?code=" & Cells(1, 3) & "&ctl00$ContentPlaceHolder1$startText=" & Cells(2, 3) & "&ctl00$ContentPlaceHolder1$endText=" & Cells(3, 3) _
    
11. , Destination:=Range("$A$10"))
    
12. .Name = "16_24"
    
13. .FieldNames = True
    
14. .RowNumbers = False
    
15. .FillAdjacentFormulas = False
    
16. .PreserveFormatting = False
    
17. .RefreshOnFileOpen = False
    
18. .BackgroundQuery = False
    
19. .RefreshStyle = xlOverwriteCells
    
20. .SavePassword = False
    
21. .SaveData = True
    
22. .AdjustColumnWidth = False
    
23. .RefreshPeriod = 0
    
24. .WebSelectionType = xlSpecifiedTables
    
25. .WebFormatting = xlWebFormattingNone
    
26. .WebTables = "2"
    
27. .WebPreFormattedTextToColumns = True
    
28. .WebConsecutiveDelimitersAsOne = True
    
29. .WebSingleBlockTextImport = False
    
30. .WebDisableDateRecognition = False
    
31. .WebDisableRedirections = False
    
32. .Refresh BackgroundQuery:=False
    
33. End With
    
34. '抓取鉅亨網資料'
    
35.     Range("A10:J50").Select
    
36.     ActiveWindow.SmallScroll Down:=-51
    
37.     Selection.AutoFilter
    
38.     ActiveWorkbook.Worksheets("工作表2").AutoFilter.Sort.SortFields.Clear
    
39.     ActiveWorkbook.Worksheets("工作表2").AutoFilter.Sort.SortFields.Add Key:=Range( _
    
40.         "A10:A31"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    
41.         xlSortNormal
    
42.     With ActiveWorkbook.Worksheets("工作表2").AutoFilter.Sort
    
43.         .Header = xlYes
    
44.         .MatchCase = False
    
45.         .Orientation = xlTopToBottom
    
46.         .SortMethod = xlPinYin
    
47.         .Apply
    
48.     End With
    
49.     '排序'
    
50.     Selection.AutoFilter
    
51.     ActiveWindow.SmallScroll Down:=-3
    
52.     Selection.ColumnWidth = 12
    
53.     Range("A8").Select
    
54.     '變更欄寬'
    
55. End Sub

複製代碼

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)