- 帖子
- 43
- 主題
- 12
- 精華
- 0
- 積分
- 72
- 點名
- 0
- 作業系統
- windows
- 軟體版本
- win 8.0
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2016-2-9
- 最後登錄
- 2020-4-13
|
上網抓股票資料
請教各位大大:
有個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 |
|
發表於 2016-3-5 01:49
| 
