VBA コード アクセス yahoo Web サイトを使用して株式データを取得する Excel を作成しました。
ほとんどの場合、Excel は問題なく動作しますが、yahoo からデータを取得できないことがあります (ルールや動機が見つからない場合もあります)。
奇妙なことに、デバッガーを使用して段階的に実行すると機能しますが、マクロを開始すると機能せず、データを取得できません。
何か考えはありますか？
ありがとう、
ジャンカルロ
私が使用する潜水艦の下で、データを取得します...
Sub StrongestSmallCaps()
Dim frequency As String
Dim numRows As Integer
Dim LastRow As Integer
Dim stockTicker As String
Dim IndR As Integer
Dim Simbolo As String
Dim rsi As String
Dim ShortInter As Boolean
Dim NonIncr As Boolean
Worksheets("GreenLine").Select
LastRow = ActiveSheet.Cells(Rows.Count, "h").End(xlUp).Row
frequency = "d"
'Cancella contenuti celle stocastici
Range("j2:k70").Clear
Range("j2:k70").Select
Selection.Style = "Stocastic"
Range("i2:i70").Clear
Range("i2:i70").Select
Selection.Style = "Tick"
Application.Wait Now + TimeValue("00:00:03")
IndR = 2
'Loop through all tickers
For Ticker = 2 To LastRow
'Application.Wait Now + TimeValue("00:00:03")
stockTicker = Worksheets("GreenLine").Range("$h$" & Ticker)
If stockTicker = "" Then
GoTo NextIteration
End If
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = stockTicker
Cells(1, 1) = "Stock Quotes for " & stockTicker
Call DownloadStockQuotes(stockTicker, Worksheets("GreenLine").Range("$b$500"), Worksheets("GreenLine").Range("$b$600"), "$a$2", frequency)
'Application.Wait Now + TimeValue("00:00:03")
Columns("a:a").TextToColumns Destination:=Range("a1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1))
Sheets(stockTicker).Columns("A:G").ColumnWidth = 10
LastRow = Sheets(stockTicker).UsedRange.Row - 2 + Sheets(stockTicker).UsedRange.Rows.Count
If LastRow < 3 Then
Application.DisplayAlerts = False
Sheets(stockTicker).delete
GoTo NextIteration
Application.DisplayAlerts = True
End If
Rows("1:1").Select
Selection.delete Shift:=xlUp
Columns("B:B").Select
Selection.delete Shift:=xlToLeft
Columns("E:E").Select
Selection.delete Shift:=xlToLeft
Columns("E:E").Select
Selection.delete Shift:=xlToLeft
Rows("2:2").Select
Selection.INSERT Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
'CALCOLA STOCHASTIC
Worksheets("GreenLine").Select
Range("Cb100:Cm122").Select
Selection.Copy
Worksheets("GreenLine").Select
Sheets(stockTicker).Select
Range("e1").Select
ActiveSheet.Paste
If Cells(3, 8) < 20 Then
Worksheets("GreenLine").Select
Cells(IndR, 9) = stockTicker
Cells(IndR, 10) = "BUY"
Cells(IndR, 10).Select
Selection.Style = "Oversold"
Application.DisplayAlerts = False
Sheets(stockTicker).delete
Application.DisplayAlerts = True
'CALCOLA RSI
'Sheets(stockTicker).Select
'If Cells(3, 16) < 20 Then
' rsi = Cells(3, 16)
' Worksheets("GreenLine").Select
'
' Cells(IndR, 9) = stockTicker
' Cells(IndR, 11) = "OVS"
' Cells(IndR, 11).Select
' Selection.Style = "Oversold"
' Selection.Style = "Comma"
' IndR = IndR + 1
' Application.DisplayAlerts = False
' Sheets(stockTicker).delete
' Application.DisplayAlerts = True
'Else
' IndR = IndR + 1
' Application.DisplayAlerts = False
' Sheets(stockTicker).delete
' Application.DisplayAlerts = True
'End If
Else
Application.DisplayAlerts = False
Sheets(stockTicker).delete
Application.DisplayAlerts = True
'Sheets(stockTicker).Select
'If Cells(3, 16) < 20 Then
' rsi = Cells(3, 16)
' Worksheets("GreenLine").Select
'
' Cells(IndR, 9) = stockTicker
' Cells(IndR, 11) = "OVS"
' Cells(IndR, 11).Select
' Selection.Style = "Oversold"
' Selection.Style = "Comma"
'
' IndR = IndR + 1
' Application.DisplayAlerts = False
' Sheets(stockTicker).delete
' Application.DisplayAlerts = True
'Else
' Application.DisplayAlerts = False
' Sheets(stockTicker).delete
' Application.DisplayAlerts = True
'End If
End If
NextIteration:
Next Ticker
ErrorHandler:
Worksheets("GreenLine").Select
Application.ScreenUpdating = True
Range("h2:h70").Clear
Range("h2:h70").Select
Selection.Style = "Normal"
E
2番目のサブ
Sub DownloadStockQuotes(ByVal stockTicker As String, ByVal startDate As Date, ByVal endDate As Date, ByVal DestinationCell As String, ByVal freq As String)
Dim qurl As String
Dim StartMonth, StartDay, StartYear, EndMonth, EndDay, EndYear As String
StartMonth = Format(Month(Date) - 8, "00")
StartDay = Format(Day(Date), "00")
StartYear = Format(Year(Date), "00")
EndMonth = Format(Month(Date) - 1, "00")
EndDay = Format(Day(Date), "00")
EndYear = Format(Year(Date), "00")
Application.Wait Now + TimeValue("00:00:03")
qurl = "URL;http://table.finance.yahoo.com/table.csv?s=" + stockTicker + "&a=" + StartMonth + "&b=" + StartDay + "&c=" + StartYear + "&d=" + EndMonth + "&e=" + EndDay + "&f=" + EndYear + "&g=" + freq + "&ignore=.csv"
Application.Wait Now + TimeValue("00:00:03")
On Error GoTo ErrorHandler:
With ActiveSheet.QueryTables.Add(Connection:=qurl, Destination:=Range(DestinationCell))
.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 = "20"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
ErrorHandler:
End Sub