返回列表 上一主題 發帖

VBA抓取網站資料

52028
　暱稱: 黑小D

中學生Rank: 2

帖子
8 
主題
3 
精華
0 
積分
56 
點名
0  
作業系統
windows 7 
軟體版本
office2010 
閱讀權限
20 
性別
男 
註冊時間
2014-9-14 
最後登錄
2016-1-8 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2015-4-30 05:10 | 只看該作者

VBA抓取網站資料

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

  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
複製代碼
收藏 分享

        靜思自在 : 甘願做、歡喜受。
返回列表 上一主題