按行和列分割文本

我正在使用Excelmacros从Yahoo Finance检索CSV文件。 在A栏中,我列出了股票代号作为input。 我曾经运行过一个macros,它会把每个ticker插入到一个URL中,然后把结果输出到B列中。然后我调用一个函数把B列中的文本分割成B列到E列。

当我创build一个连接的URLstring并调用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时,我可以将必要的数据与“文本到列”function分开。 现在我需要它由列和行分开。

 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 

我明白这不是处理这类问题的最好方法,但它应该起作用。

首先,我们需要改变你的Delimiter (这是好的!),所以它可以处理从响应中提取的行:

 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”单元(或者改变macros)。

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

我不确定你需要什么,但是你可以尝试使用这个函数来提取你需要的string

 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 

这将从您在表格中获得的原始string中提取公司名称。

希望能帮助到你

热心的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