按行和列拆分文本

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"

当前输出

Expected/Ideal输出

当我一次调用 URL 一个自动收报机时，我可以使用“文本到列”功能分离出必要的数据。现在我需要它按列和行分隔。

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

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

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

这会从您在 table 中获得的原始字符串中提取公司名称。

希望对您有所帮助

Answer 2

热心 VB 新手警报。

Private Sub so_stub_1()
 'wsSo is the name of my test worksheet
  Dim hdr() As String: hdr = Split("Last Close Price, Market Cap, Company Name, Annual Revenue", ",")
  Dim data() As Variant: data = wsSO.Range("G1:G4")
  Dim i As Integer
  Dim r As Integer
  For i = 1 To UBound(data) 
    r = i + 1 'offset in my test sheet
    wsSO.Range("A" & r & ":D" & r) = Split(data(i, 1), ",")
 Next 'i 
End Sub

Answer 3

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

首先我们需要更改您的 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

我刚刚检查了您的示例并且它有效。您只需将您的回复放入 "A1" 单元格（或更改宏）。

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

按行和列拆分文本

Splitting Text By Rows and Columns

excel

vba

split

delimiter