Question

我正在使用Excel宏从Yahoo Finance检索CSV文件。在A栏中，我将股票代码列为输入。我曾经运行一个宏，将每个自动收报机插入一个URL，然后将结果输出到B列。然后我会调用一个函数将B列中的文本拆分为B列到E列。

当我创建一个连接的URL字符串并只调用一次URL时，该函数变得更快。主要问题是我收到的格式如下：

"81.950,342.05B,"Exxon Mobil Corporation Common ",263.71B
81.38,201.29B,"Alibaba Group Holding Limited A",13.56B
754.77,519.78B,"Alphabet Inc.",71.76B
120.57,649.30B,"Apple Inc.",233.72B"

当前输出

预期/理想输出

当我一次向URL调用一个滚动条时，我可以将所需的数据与Text to Columns函数分开。现在我需要用列和行分隔它。

Sub StockDataPull() 
Dim url As String
Dim http As Object
Dim LastRow As Long
Dim Symbol_rng As Range
Dim Output_rng As Range

'Define Last Row in Ticker Range
    With ActiveSheet
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With

    Application.ScreenUpdating = False

Set Symbol_rng = Range("A5:A" & LastRow).Cells
Set Output_rng = Range("C5:F" & LastRow).Cells

    'Open Yahoo Finance URL
        url = "http://download.finance.yahoo.com/d/quotes.csv?s=" & concatRange(Symbol_rng) & "&f=pj1ns6"
                Set http = CreateObject("MSXML2.XMLHTTP")
        http.Open "GET", url, False
        http.Send
                    Output_rng = http.responseText
           Set http = Nothing
    Application.DisplayAlerts = False
    Application.ScreenUpdating = True
End Sub


'The code below is what I used before Sub StockDataPull(). This code calls a URL for each ticker, instead of one URL for all tickers in a concatenated string. It's considerably slower, but it works because it outputs the data two cells away from the ticker, then I call Sub Delimiter() to separate it across the next few consecutive columns.


Sub StockData()
Dim url As String
Dim http As Object
Dim LastRow As Long
Dim Symbol_rng As Range

''Define Last Row in Ticker Range
    With ActiveSheet
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With

    Application.ScreenUpdating = False

Set Symbol_rng = Range("A5:A" & LastRow).Cells

    For Each cell In Symbol_rng

    ''Open Yahoo Finance URL
        url = "http://download.finance.yahoo.com/d/quotes.csv?s=" & cell.Value & "&f=pj1ns6"

        Set http = CreateObject("MSXML2.XMLHTTP")
        http.Open "GET", url, False
        http.Send

        cell.Offset(rowOffset:=0, columnOffset:=2) = http.responseText

        Set http = Nothing

    Next cell

        Application.DisplayAlerts = False    
        Application.ScreenUpdating = True    
        Call Delimiter            
    End Sub

Sub Delimiter()    
''Define Last Row in Ticker Range
    With ActiveSheet
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With

''Separate the data into four columns
    Range("C5:C" & LastRow).TextToColumns Destination:=Range("C5"), 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)), TrailingMinusNumbers:=True

''Unwrap the text
    Range("C5:F" & LastRow).Select
    With Selection
        .WrapText = False
    End With

End Sub

Answer 1

我知道这不是处理此类问题的最佳方法，但它应该有效。

首先，我们需要更改您的Delimiter sub（这很好！），以便它可以处理从响应中提取的行：

Sub Delimiter(ByVal LastRow)
''Separate the data into four columns
    Range("B1:B" & LastRow).TextToColumns Destination:=Range("C1:C" & LastRow), 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)), TrailingMinusNumbers:=True

''Unwrap the text
    Range("B1:F" & LastRow).Select
    With Selection
        .WrapText = False
    End With

End Sub

以下是如何以适当方式分割您的回复：

Sub SplitToLines()
    s = Cells(1, "A")
    If Left(s, 1) = """" Then
        s = Mid(s, 2)
    End If

    If Right(s, 1) = """" Then
        s = Mid(s, 1, Len(s) - 1)
    End If

    resLines = Split(s, vbLf)

    For i = LBound(resLines) To UBound(resLines)
        Cells(i + 1, "B") = resLines(i)
    Next i
    Delimiter (i + 1)

End Sub

我刚检查了你的例子，它确实有效。您所需要的只是将您的回复放在＆＃34; A1＆＃34;单元格（或更改宏）。

如果您遇到问题，请告诉我。

Answer 2

我不确定你需要什么，但你可以尝试用这个功能提取你需要的字符串

Function ExtractText(ByVal Txt As String) As String
    Txt = Right(Txt, Len(Txt) - InStr(1, Txt, ",""", vbTextCompare) - 1)
    Txt = Left(Txt, InStr(1, Txt, """,", vbTextCompare) - 1)
End Function

这会从表格中的原始字符串中提取公司名称。

希望有所帮助

Answer 3

Zealous VB新手警报。

while(*c1++);

按行和列拆分文本

3 个答案: