☰

웹 쿼리를 반복하는 매크로 - 계속해서 폭격을 가함

tag-icon • tag-icon microsoft-excel vba macros
웹 쿼리를 반복하는 매크로 - 계속해서 폭격을 가함

주식 시세 표시기와 열을 반복하고 웹 쿼리를 사용하여 Yahoo Finance에서 해당 주식 시세에 대한 데이터를 가져오도록 매크로를 구축했습니다.

10,15,20개의 웹 쿼리에 대해서는 잘 실행되지만 처음 20개 또는 30개의 웹 쿼리 중 어느 시점에서는 오류 없이 탁월한 성능을 발휘합니다.

나는 VBA 코드에 있어서 극도의 아마추어라고 가장 먼저 말하겠지만, 이 문제를 해결하기 위해 몇 가지 방법(캐시 지우기, 일시 중지 사용)을 시도했지만 작동하지 않는 것 같습니다.

매번 같은 항목에서 실패하는 것은 아니지만 항상 상태 표시줄에 "웹에 연결하는 중"이라는 텍스트가 있어서 연결 시간 초과와 관련이 있는 것 같은 느낌이 들지만 어떻게 되는지는 잘 모르겠습니다. 이때 공격을 하게 됩니다. 제가 놓쳤을 수 있는 코드 최적화는 물론 어떤 아이디어라도 환영합니다. 감사합니다!

Sub GetData()

    Application.Calculation = xlManual

     ' make the website a variable
    Dim sURL As String
    Dim Ticker As String
    Dim iRow As Integer
    Dim iCol As Integer
    Dim wqError As ErrObject

     ' create web query if it doesn't exist

    If Worksheets("query").QueryTables.Count = 0 Then
        With Worksheets("query").QueryTables.Add(Connection:="URL;", Destination:=Range("Query!A1"))
            .Name = "market_data.asp"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .WebSelectionType = xlSpecifiedTables
            .WebFormatting = xlWebFormattingNone
            .WebTables = "4"
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
        End With
    End If

    iRow = 2
    iCol = 2

     'Loop through Tickers

    Do While Worksheets("Data").Range("A" & iRow).Value <> ""

            Ticker = Worksheets("Data").Range("A" & iRow).Value
            sURL = "http://finance.yahoo.com/q?s=" & Ticker

            With Worksheets("query")
                .Cells.Clear
                .QueryTables(1).Connection = "URL;" & sURL
                On Error Resume Next
                .QueryTables(1).Refresh BackgroundQuery:=False
                Set wqError = Err
                On Error GoTo 0

                If wqError.Number = 0 Then 'No error

                    .Range("B1").Copy Worksheets("Data").Cells(iRow, iCol)
                    .Range("B5").Copy Worksheets("Data").Cells(iRow, iCol + 1)
                    .Range("B13:B14").Copy Worksheets("Data").Cells(iRow, iCol + 2)
                    .Range("B18").Copy Worksheets("Data").Cells(iRow, iCol + 4)
                    .Range("B15").Copy Worksheets("Data").Cells(iRow, iCol + 5)
                    .Range("B22").Copy Worksheets("Data").Cells(iRow, iCol + 6)
                    .Range("B16").Copy Worksheets("Data").Cells(iRow, iCol + 7)
                    .Range("B20").Copy Worksheets("Data").Cells(iRow, iCol + 8)
                    .Range("B19").Copy Worksheets("Data").Cells(iRow, iCol + 9)
                    .Range("B25").Copy Worksheets("Data").Cells(iRow, iCol + 10)
                    .Range("B24").Copy Worksheets("Data").Cells(iRow, iCol + 11)

                ElseIf wqError.Number <> 1004 Then

                     'Report error because it isn't the expected error 1004 Web query returned no data

                    MsgBox "Web query refresh for " & String(2, vbCrLf) & sURL & String(2, vbCrLf) & " returned error number " & wqError.Number & String(2, vbCrLf) & wqError.Description

                End If

            End With

        iRow = iRow + 1
        If iRow Mod 5 = 0 Then Delete_IE_Cache
        If iRow Mod 20 = 0 Then ActiveWorkbook.Save
        If iRow Mod 20 = 0 Then Application.Wait (Now + TimeValue("0:00:03"))

    Loop

     'Format results

    With Sheets("data")
    Range("A:M").HorizontalAlignment = xlCenter
    Range("A:A").NumberFormat = "Text"
    Range("D:D").NumberFormat = "Text"
    Range("I:I").NumberFormat = "Text"
    Range("B:C").NumberFormat = "0.00"
    Range("E:H").NumberFormat = "0.00"
    Range("K:M").NumberFormat = "0.00"
    End With

    Application.Calculation = xlCalculationAutomatic

End Sub

답변1

페이지 로드가 완료될 때까지 기다리는 코드가 표시되지 않습니다... 필요하지 않을 수도 있지만 모듈 상단에 이를 배치한 다음 웹사이트+주식 표시기로 이동한 후 호출해도 문제가 되지 않습니다. .

Private Declare Sub AppSleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)
Public Sub PauseApp(PauseInSeconds As Long)
Call AppSleep(PauseInSeconds)
End Sub

그런 다음 코드에서

sURL = "http://finance.yahoo.com/q?s=" & Ticker 
Call sleepie(sURL)

내가 말했듯이, 그것은 당신의 문제를 전혀 해결하지 못할 수도 있지만 가장 확실히 도움이 될 것입니다.

관련 정보