excel - キャッシュをクリアした後でも VBA 複数の Web クエリがハングする

Question

どこにも解決策が見つかりませんでした。Web クエリを使用して、約 500 銘柄の株式データをダウンロードしています。在庫リスト全体をダウンロードする前に最終的にハングし、プロセスを終了する必要があります。リストを3つの別々の部分に分割すると機能します。キャッシュをクリアする頻度をいじりましたが、問題は解決しませんでした。どんな助けでも大歓迎です！

Private Sub Download_Click()
Dim i As Long, j As Long, STEnd As Long, STArray As Variant, TempSht As String, ST As String, SH As Worksheet
Dim symbols As String, sline As String, Values As Variant
Dim W As Worksheet: Set W = ActiveSheet
Dim ResearchSht As Worksheet: Set ResearchSht = ThisWorkbook.Sheets("Research")
Dim Last As Long

   Application.DisplayAlerts = False
   Application.ScreenUpdating = False
   Application.Calculation = xlCalculateManual

TempSht = "Template"

'Delete Old Sheets
For Each SH In ThisWorkbook.Sheets
Select Case SH.Name
    Case ResearchSht.Name, "Template", "Trades"
    Case Else
        SH.Delete
End Select
Next

Last = ResearchSht.Cells(Rows.Count, 1).End(xlUp).Row
If Last = 1 Then Exit Sub
For j = 2 To Last
    ST = UCase(Trim(ResearchSht.Cells(j, 1)))
    ResearchSht.Cells(j, 1) = ST
    Worksheets.Add.Name = ST
    Select Case ST
        Case "^GSPC"
            SD = Day(Now)
            SM = Month(Now) - 1
            SY = Year(Now) - 10
            SY_2 = Year(Now)
        Case Else
            Check_Date
    End Select

    With ActiveSheet.QueryTables.Add(Connection:="URL;http://ichart.finance.yahoo.com/table.csv?s=" & ST & "&d=" & SM & "&e=" & SD & "&f=" & SY_2 & "&g=d&a=" & SM & "&b=" & SD & "&c=" & SY, Destination:=Sheets(ST).Range("$A$1"))
        .Name = ST
        .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 = "1,2"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With

    'Split CSV data into columns
    STEnd = Sheets(ST).Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To STEnd - 1
        STArray = Split(Sheets(ST).Cells(i, 1), ",")
        Sheets(ST).Cells(i, 1).Value = STArray(0)
        Sheets(ST).Cells(i, 2).Value = STArray(1)
        Sheets(ST).Cells(i, 3).Value = STArray(2)
        Sheets(ST).Cells(i, 4).Value = STArray(3)
        Sheets(ST).Cells(i, 5).Value = STArray(4)
        Sheets(ST).Cells(i, 6).Value = STArray(5)
        Sheets(ST).Cells(i, 7).Value = STArray(6)
    Next
    Sheets(TempSht).Range("H:AU").Copy Destination:=Sheets(ST).Range("H1")
    Application.Calculation = xlCalculationAutomatic
    Sheets(ST).Range("H:AL").Copy
    Sheets(ST).Range("H1").PasteSpecial Paste:=xlValues
    Application.Calculation = xlCalculateManual
    Sheets(ST).Cells.EntireColumn.AutoFit
    ActiveSheet.Visible = xlSheetHidden

  Select Case j
      Case 10, 20, 30, 40, 50, 60, 70, 80, 90, 100, 110, 120, 130, 140, 150, 160, 170, 180, 190, 200, 210, 220, 230, 240, 250, 260, 270, 280, 290, 300, 310, 320, 330, 340, 350, 360, 370, 380, 390, 400, 410, 420, 430, 440, 450, 460, 470, 480, 490, 500, 510, 520, 530, 540, 550, 560, 570, 580, 590, 600, 610, 620, 630, 640, 650, 660, 670, 680, 690, 700, 710, 720, 730, 740, 750, 760, 770, 780, 790, 800, 810, 820, 830, 840, 850, 860, 870, 880, 890, 900, 910, 920, 930, 940, 950, 960, 970, 980, 990, 1000, 1010
          Shell "RunDll32.exe InetCpl.Cpl,ClearMyTracksByProcess 8"
  End Select
  'If ST <> "^GSPC" Then Sheets(ST).Delete 'Test
Next

ResearchSht.Activate
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True