#vba #excel #split #string-concatenation
#vba #excel #разделение #конкатенация строк
Вопрос:
У меня есть несколько строк строк, которые являются как текстом, так и числами. Я хочу сделать текст в столбцах, который разделяет это пробелами, за исключением первой и последней частей.
Если я запускаю текст в столбцы, разделенные пробелами, тогда он разбивает строки, которые я не хочу разделять.
Пример:
Quarterly Performance Numbers 999,999.99 12.00 1.00 2.00 3.00 4.00 Dec 09, 2013
Становится:
Quarterly|Performance|Numbers|999,999.99|12.00|1.00|2.00|3.00|4.00|Dec|09,|2013
Чего я хочу:
Quarterly Performance Numbers|999,999.99|12.00|1.00|2.00|3.00|4.00|Dec 09, 2013
Проблема в том, что часть имеет различную длину и количество слов (где-то от 3 до 6).
Есть ли способ, которым я могу создать текстовые классификаторы вокруг этих двух строк в VBA?
Sub Macro3()
Dim i As Integer
Dim LastRow As Long
LastRow = ActiveSheet.UsedRange.Rows.Count
For i = 1 To LastRow
Cells(i, 2).Value = Mid(Cells(i, 1), 29, 37)
Cells(i, 3).Value = Right(Cells(i, 1), 12)
Cells(i, 1).Value = Left(Cells(i, 1), 37)
Next i
End Sub
Комментарии:
1. Откуда берутся эти данные? Можете ли вы убедить источник экспортировать его в формате CSV вместо этого?
2. Да, есть способ сделать это в VBA, и если вы покажете нам свою попытку, мы поможем вам ее отладить.
3. Чарльз: Я пытался. Источник помещает данные только в PDF-файлы, но сказал, что они могут переключиться в будущем. На данный момент я просто скопировал ее в Excel.
4. Жан: Мне нравится твой стиль. Дайте мне минуту.
5. Насколько сильно меняется формат? Это почти всегда такой набор данных, просто разные числа?
Ответ №1:
Sub Test()
Dim sContent, oMatch, arrParsed(), sResult
sContent = "Quarterly Performance Numbers 999,999.99 12.00 1.00 2.00 3.00 4.00 Dec 09, 2013"
arrParsed = Array()
With New RegExp ' Tools - References - add "Microsoft VBScript Regular Expressions 5.5" or use With CreateObject("VBScript.RegExp")
.Pattern = "(?:(?:[a-z ] (?= )){3,6}|(?:-*[d,.] (?= ))|(?:[a-z]{3} d{2}, d{4}))"
.Global = True
.IgnoreCase = True
For Each oMatch In .Execute(sContent)
ReDim Preserve arrParsed(UBound(arrParsed) 1)
arrParsed(UBound(arrParsed)) = oMatch.Value
Next
End With
' here you can use arrParsed
sResult = Join(arrParsed, ";")
MsgBox sResult
End Sub
Комментарии:
1. Это работает для большинства строк. Можете ли вы помочь мне понять шаблон? Также кажется, что это удаляет вещи.
2. Моя подсказка — начать, например , с http://msdn.microsoft.com/en-us/library/1400241x.aspx , также удобно использовать специальный плагин Notepad RegEx Helper или другой инструмент для создания шаблонов. Для каких строк этот шаблон не работает? Наверное, я забыл минус для отрицательных чисел?
3. Есть несколько первых строк, которые переносятся через дефис, где он просто удаляет часть строки. Я проверяю эту ссылку. Спасибо.
Ответ №2:
Я нашел способ, который работает. Как меня предупреждали, регулярное выражение оказалось скорее проблемой, чем решением. Мой метод не очень хорош, но он выполняет свою работу. Я подсчитываю количество пробелов, вычитая длину строки на длину строки после удаления пробелов. Единственная переменная в пробелах зависит от количества пробелов в описании, и поэтому, если я вычту 8 минимальных пробелов из общего количества пробелов, я могу использовать его для замены N-го пробела на «;». Я делаю это 7 раз, и все мои столбцы отображаются правильно в виде текста с разделителями по столбцам. Спасибо всем. Извините, если мое объяснение отстой.
Sub Macro14()
Dim i As Long
Dim smaller As String
Dim spaces As Integer
Dim fixed As String
Dim LastRow As Long
LastRow = ActiveSheet.UsedRange.Rows.Count
For i = 1 To LastRow
smaller = Replace(Cells(i, 1), " ", "")
spaces = Len(Cells(i, 1)) - Len(smaller) - 8
fixed = Cells(i, 1).Value
fixed = WorksheetFunction.Substitute(fixed, " ", ";", spaces) 'after desc
fixed = WorksheetFunction.Substitute(fixed, " ", ";", spaces) 'after value
fixed = WorksheetFunction.Substitute(fixed, " ", ";", spaces) 'after %age
fixed = WorksheetFunction.Substitute(fixed, " ", ";", spaces) 'after first perf column
fixed = WorksheetFunction.Substitute(fixed, " ", ";", spaces) 'after second perf column
fixed = WorksheetFunction.Substitute(fixed, " ", ";", spaces) 'after third perf column
fixed = WorksheetFunction.Substitute(fixed, " ", ";", spaces) 'after fourth perf column/before the date
Cells(i, 1).Value = fixed
Next i
End Sub