返回列表下一主題上一主題發帖

上網抓股票資料

chairles59

中學生 Rank: 2

帖子: 43
主題: 12
精華: 0
積分: 72
點名: 0
作業系統: windows
軟體版本: win 8.0
閱讀權限: 20
性別: 男
註冊時間: 2016-2-9
最後登錄: 2020-4-13

論壇贊助勳章

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2016-3-5 01:49 | 顯示全部帖子

上網抓股票資料

請教各位大大:
有個VBA程式資料抓不下來
請各位大大幫忙查看哪裡有問題
謝謝
Private Sub CommandButton1_Click()
Dim po As Integer       '宣告PO為整數

lR = Range("A2").End(xlDown).Row
Rows(lR + 1 & ":400").Select    'a欄空白以下全刪除
Selection.Delete shift:=xlUp

LRA = Range("C2").End(xlDown).Row
For i = 3 To LRA
If Cells(i, 5) <> "" Then
ValueSno = "$A$" & i
Linkss = "URL;https://tw.stock.yahoo.com/q/q?s=" & Cells(i, 1)

po = lR - 5 + (7 * (i - 2)) '定抓取資料表格迴圈
With ActiveSheet.QueryTables.Add(Connection:= _
Linkss, Destination:=Sheets("工作表1").Range("b" & po))
   .FieldNames = True
      .RowNumbers = False
      .FillAdjacentFormulas = False
      .PreserveFormatting = True
      .RefreshOnFileOpen = False
      .BackgroundQuery = True
      .RefreshStyle = xlInsertDeleteCells
      .SavePassword = False
      .SaveData = True
      .AdjustColumnWidth = True
      .RefreshPeriod = 0
      .WebSelectionType = xlSpecifiedTables
      .WebFormatting = xlWebFormattingNone
      .WebTables = "6"
      .WebPreFormattedTextToColumns = True
      .WebConsecutiveDelimitersAsOne = True
      .WebSingleBlockTextImport = False
      .WebDisableDateRecognition = False
      .WebDisableRedirections = False
      .Refresh BackgroundQuery:=False
      .Name = .ResultRange.Cells(3, 1)
End With
Range("A" & po + 2) = Cells(i, 1)
Cells(i, 2) = "=vlookup(" & Cells(i, 1) & ",$A$16:$0$200,2,0)"
Cells(i, 2) = Mid(Cells(i, 2), 5)
Cells(i, 7) = "=vlookup(" & Cells(i, 1) & ",$A$16:$0$200,4,0)"
End If
Next

End Sub