0

在任何地方都找不到解决方案。我正在使用 Web Query 下载大约 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
4

0 回答 0