Разделение текста по строкам и столбцам

Я использую макрос Excel для извлечения CSV-файла из Yahoo Finance. В столбце 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 один тикер за раз, я мог разделить необходимые данные с помощью функции «Текст в столбцы». Теперь мне нужно, чтобы они были разделены столбцами и строками.

 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 

Я понимаю, что это не лучший способ справиться с этой проблемой, но она должна работать.

Прежде всего, нам нужно сменить Sub-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» (или изменить макрос).

Дайте мне знать, если у вас возникнут проблемы с этим.

Я не уверен, что вам нужно, но вы можете попытаться извлечь нужную строку с помощью этой функции

 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 

Это извлечет название компании из исходной строки, которую вы получите в таблице.

Надеюсь, поможет

Ревнивый приветствие новичка 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 
Давайте будем гением компьютера.