如何更改才能在相同xls的其他工作表中使用它

Question

Option Explicit
Dim numRows1 As Integer

Sub GetData()
    Dim ParameterSheet As Worksheet
    Dim DataSheet As Worksheet
    Dim ticker As String
    Dim exchange As String
    Dim interval As Integer
    Dim numPastTradingDays As Integer
    Dim qurl As String

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual

    Set ParameterSheet = Sheets("Parameters")
    Set DataSheet = Sheets("Data")

    Dim Fields1() As String
    Fields1 = Split(ParameterSheet.Range("ticker").Value, ",")

    DataSheet.Cells.Clear
    DataSheet.Range("e24") = "Spread"
    DataSheet.Range("f24") = "Average"
    ticker = Fields1(0)
    exchange = ParameterSheet.Range("exchange").Value
    interval = ParameterSheet.Range("interval").Value
    numPastTradingDays = ParameterSheet.Range("numTradingDays").Value

    qurl = "http://www.google.com/finance/getprices?" & _
           "q=" & ticker & _
           "&x=NSE" & _
           "&i=" & interval & _
           "&p=" & numPastTradingDays & "d" & _
           "&f=c"
           '"&f=d,o,h,l,c"


QueryQuote:
    With DataSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range("a18"))
        .BackgroundQuery = True
        .TablesOnlyFromHTML = False
        .Refresh BackgroundQuery:=False
        .SaveData = True
    End With

    DataSheet.Range("a18").CurrentRegion.TextToColumns Destination:=DataSheet.Range("a18"), DataType:=xlDelimited, _
                                                      TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                                                      Semicolon:=False, Comma:=True, Space:=False, other:=False

    DataSheet.Columns("A:G").ColumnWidth = 12

    '===Convert Google timestamp to Excel timestamp (only for Windows)
    Dim timeStamp As Double
    Dim timeStampRaw As String
    Dim timeZoneOffsetRaw As String
    Dim timeZoneOffset As Variant

    Dim i As Integer
    numRows1 = DataSheet.UsedRange.Rows.count - 1
    numRows1 = numRows1 + 17
    timeZoneOffsetRaw = DataSheet.Range("a24")
    timeZoneOffset = (Mid(timeZoneOffsetRaw, InStr(timeZoneOffsetRaw, "=") + 1, 10))

    For i = 25 To numRows1

        If Not IsNumeric(DataSheet.Range("a" & i)) Then

            timeStampRaw = DataSheet.Range("a" & i)
            timeStamp = (Mid(timeStampRaw, 2, Len(timeStampRaw) - 1))
            timeStamp = (timeStamp + timeZoneOffset * 60)
            DataSheet.Range("b" & i) = timeStamp / 86400 + 25569

        Else

            DataSheet.Range("b" & i).FormulaR1C1 = "=(RC[-6]*" & interval & "+" & timeStamp & ")/86400+25569"

        End If

    Next

    DataSheet.Range("b8:b" & numRows1).NumberFormat = "d mmm yyyy h:mm;@"
    DataSheet.Range("B:B").Columns.AutoFit
    'DataSheet.UsedRange.Rows.count
    Application.Calculation = xlCalculationAutomatic

    Call GetData2

End Sub

Sub GetData2()
    Dim ParameterSheet As Worksheet
    Dim DataSheet As Worksheet
    Dim ticker2 As String
    Dim exchange As String
    Dim interval As Integer
    Dim numPastTradingDays As Integer
    Dim qurl As String

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual

    Set ParameterSheet = Sheets("Parameters")
    Set DataSheet = Sheets("Data")

    '--DataSheet.Cells.Clear
    Dim Fields() As String
    Fields = Split(ParameterSheet.Range("ticker").Value, ",")
    'Print Fields(0) 'Name
    'Print Fields(1) 'Dept

    'ticker2 = ParameterSheet.Range("ticker").Value
    ticker2 = Fields(1)
    exchange = ParameterSheet.Range("exchange").Value
    interval = ParameterSheet.Range("interval").Value
    numPastTradingDays = ParameterSheet.Range("numTradingDays").Value

    qurl = "http://www.google.com/finance/getprices?" & _
           "q=" & ticker2 & _
           "&x=NSE" & _
           "&i=" & interval & _
           "&p=" & numPastTradingDays & "d" & _
            "&f=c"
           '"&f=d,o,h,l,c"

QueryQuote:
    With DataSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range("i18"))
        .BackgroundQuery = True
        .TablesOnlyFromHTML = False
        .Refresh BackgroundQuery:=False
        .SaveData = True
    End With

    DataSheet.Range("i18").CurrentRegion.TextToColumns Destination:=DataSheet.Range("i18"), DataType:=xlDelimited, _
                                                      TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                                                      Semicolon:=False, Comma:=True, Space:=False, other:=False

    DataSheet.Columns("I:O").ColumnWidth = 12

    '===Convert Google timestamp to Excel timestamp (only for Windows)
    Dim timeStamp As Double
    Dim timeStampRaw As String
    Dim timeZoneOffsetRaw As String
    Dim timeZoneOffset As Variant
    Dim numRows As Integer
    Dim i As Integer
    Dim x As Integer
    numRows = DataSheet.UsedRange.Rows.count - 1

    timeZoneOffsetRaw = DataSheet.Range("i24")
    timeZoneOffset = (Mid(timeZoneOffsetRaw, InStr(timeZoneOffsetRaw, "=") + 1, 10))

    For i = 25 To numRows

        If Not IsNumeric(DataSheet.Range("i" & i)) Then

            timeStampRaw = DataSheet.Range("i" & i)
            timeStamp = (Mid(timeStampRaw, 2, Len(timeStampRaw) - 1))
            timeStamp = (timeStamp + timeZoneOffset * 60)
            DataSheet.Range("j" & i) = timeStamp / 86400 + 25569

        Else

            DataSheet.Range("j" & i).FormulaR1C1 = "=(RC[-6]*" & interval & "+" & timeStamp & ")/86400+25569"

        End If

    Next

    DataSheet.Range("j8:j" & numRows).NumberFormat = "d mmm yyyy h:mm;@"
    DataSheet.Range("J:J").Columns.AutoFit

    Application.Calculation = xlCalculationAutomatic


    '----Logic for spread and average
    'For i = 1 To (numRows + 7)

    'For i = 1 to

    For i = 25 To (numRows1 + 1)
        If i = 1 Then
          i = i + 24
        Else
        End If
        If Trim(DataSheet.Range("a" & i)) = "" Or Trim(DataSheet.Range("i" & i)) = "" Then

        Else
         DataSheet.Range("e" & i) = "=" & (DataSheet.Range("a" & i) & "/" & DataSheet.Range("i" & i))
        End If

    Next

   ' If numRows1 = 24 Then
   '     DataSheet.Range("e25") = "=" & (DataSheet.Range("a25") & "/" & DataSheet.Range("i25"))
   ' ElseIf numRows1 = 25 Then
   '     DataSheet.Range("e26") = "=" & (DataSheet.Range("a26") & "/" & DataSheet.Range("i26"))
   ' ElseIf numRows1 = 26 Then
   '     DataSheet.Range("e27") = "=" & (DataSheet.Range("a27") & "/" & DataSheet.Range("i27"))
   ' End If


    i = 0


    If Trim(DataSheet.Range("e" & (numRows1 + 1))) = "" Then
       numRows1 = numRows1 - 1
    End If
    For i = 1 To (numRows1 + 1)
        If i = 1 Then
          i = i + 24
        Else

        End If
       ' If numRows1 = 24 Then
       '     DataSheet.Range("f25") = "=" & "Average(" & (DataSheet.Range("e25") & "/" & DataSheet.Range("e25")) & ")"
       ' ElseIf numRows1 = 25 Then
       '     DataSheet.Range("f25") = "=" & "Average(" & (DataSheet.Range("e25") & "/" & DataSheet.Range("e26")) & ")"
        '    DataSheet.Range("f26") = "=" & "Average(" & (DataSheet.Range("e26") & "/" & DataSheet.Range("e26")) & ")"
       ' Else

        'DataSheet.Range("f" & i) = "=" & "Average(" & (DataSheet.Range("e" & i) & ":" & DataSheet.Range("e" & (numRows1 + 1))) & ")"
        If i = 25 Then
          DataSheet.Range("f" & i) = "=" & "Average(E" & i & ":" & "E" & (numRows1 + 1) & ")"
        Else
          DataSheet.Range("f" & i) = DataSheet.Range("f25")
        End If
    Next

    Application.OnTime Now + TimeValue("00:01:10"), "GetData"

End Sub

Answer 1

您可以通过使用一个外部循环来压缩您的代码，该外部循环从一个工作表更改到下一个工作表，并根据查找值使用不同的数据集填充每个工作表。

一种方法是将ticker作为参数传递。

Call LoadFromYahoo("MSFT")
Call LoadFromYahoo("BOA")
...

或者，您可以将滚动条列表放在一个工作表上并读取该列表，为每个滚动条添加新的工作表，然后加载数据并将选项卡重命名为滚动条。

public sub    LoadFromYahoo()

  Dim tWS as worksheet
  dim aCell as range
  dim sWS as worksheet

  set sws = thisworkbook.sheets("Sheet1")    'List of tickers in column A
  for each acell in intersect(sws.range("A1").entirecolumn, sws.usedrange)
    set tws = worksheets.add
    with tws
       call GetFromYahoo(acell.value)  'function to make your yahoo call
    end with
  next acell

exit sub