Excel или VBA для преобразования неструктурированного текста в столбец

Question

Как я могу преобразовать текст в столбец, если текст не структурирован без правильных разделителей.

Например, как я могу превратить следующие строки:

В нечто вроде:

В Excel текст в столбцы, кажется, не находит правильный разделитель (пробел, табуляция, ...).Я пробовал в VBA со следующим:

I1 = Mid(Cells(i, 1), 1, 16)
I2 = Mid(Cells(i, 1), 17, 33)
I3 = Mid(Cells(i, 1), 34, 49)
I4 = Mid(Cells(i, 1), 50, 53)
I5 = Mid(Cells(i, 1), 54, 66)
I6 = Mid(Cells(i, 1), 67, 82)
I7 = Mid(Cells(i, 1), 83, 99)
I8 = Mid(Cells(i, 1), 100, 116)
I9 = Mid(Cells(i, 1), 117, 133)

Но я понимаю, что это не работает для всех столбцов.Например, для I3 я получаю гораздо больше ожидаемых значений, например:

Я также попытался заменить вкладку (если она существовала), например:

MyString = Replace(MyString, vbTab, "")

Но тоже не сработало.

Есть ли другой способ подойти к нему?

Answer 1

Данные, которые вы предоставляете, имеют регулярную структуру, предполагая, что Категория может быть только одним из нескольких определенных слов.

Можно также предположить, что в UOM есть только несколько определенных слов, если Категория будет толькокогда-нибудь одно слово.Например,

• Элемент: первая подстрока, за которой следует пробел
• Описание: переменное количество слов, за которыми следует категория
• Категория: из списка определенных слов
• UOM: из списка определенных слов
• А затем все остальные разделены пробелом.

Из этого шаблона мы можем построить регулярное выражение и использовать его вМакрос VBA для разделения строки.Конечно, если шаблон отличается от этого, метод не будет работать.Но вам нужно будет привести примеры, которые охватывают всю изменчивость.

В приведенном ниже макросе предполагается, что Category будет либо ASSIGNED, либо UNASSIGNED, но вы можете добавить больше слов в разделенный трубами списокв коде.

Другие предположения в коде.

Option Explicit
Sub parseLine()
    Dim WS As Worksheet, R As Range, C As Range
    Dim RE As Object, MC As Object
    Dim vRes As Variant, I As Long

'Set original worksheet/range
'change to suit
'Below uses column A
Set WS = Worksheets("sheet1")
With WS
    Set R = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With

'Initialize regex engine
Set RE = CreateObject("vbscript.regexp")
With RE
    .Pattern = "^(\S+)\s+(.*)\s*\b(UNASSIGNED|ASSIGNED)\b\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)"
    .IgnoreCase = False
    .MultiLine = True
    .Global = True
End With

'Iterate through; create the Parse line and parse
Application.ScreenUpdating = False
For Each C In R
    If RE.Test(C.Text) = True Then
        Set MC = RE.Execute(C.Text)
        ReDim vRes(1 To MC(0).SubMatches.Count)
        For I = 1 To UBound(vRes)
            vRes(I) = MC(0).SubMatches(I - 1)
        Next I

        'write the results next to the column)
        With C.Offset(0, 1).Resize(columnsize:=UBound(vRes))
            .Clear
            .NumberFormat = "@"
            .Value = vRes
            .EntireColumn.AutoFit
        End With
    End If
Next C
Application.ScreenUpdating = True

End Sub

Answer 2

Вот попытка использования пользовательской функции ReplaceWhitespace, которая поочередно заменяет участки пробела в зависимости от их длины.В качестве промежуточного шага пробел заменяется точкой с запятой;ненужные точки с запятой удаляются как последний шаг.Split используется для чтения проанализированной строки в массив, а массив используется для чтения результата на листе.Это должно быть просто настроить ReplaceWhitespace для ваших конкретных потребностей.

Обратите внимание, что этот алгоритм не оценивает, должны ли экземпляры одного символа пробела рассматриваться как шум (как в "TUBELINES UNASSIGNED") или как действительный разделитель слов (как в "Стоимость единицы").Поэтому единичные пробелы как шум рассматриваются как особые случаи в ReplaceWhitespace: "- -" ~~> "-;-" и " UNASSIGNED " ~~> ";UNASSIGNED;"

Если предположить, что ваши данные со скриншота находятся в диапазоне A1:A4, этот код создает более или менеежелаемый результат, как показано на скриншоте ниже.

РЕДАКТИРОВАТЬ: Первоначальный дизайн ReplaceWhitespace был основан на проб и ошибок.Немного подумав, я понял, что шаблоны, в которых количество пробельных символов или точек с запятой представляет собой составное число , будут обрабатываться теми строками в алгоритме, который ищет шаблоны, в которых количество символов является простым числом.,Я обновил код соответствующим образом.

Sub ParseUnstructured()
    Dim i As Long
    For Each cell In Range("A1:A4")
        i = i + 1
        ' Clean whitespace:
        sRow = ReplaceWhitespace(cell.Value)
        ' Read to array
        Dim sArray() As String
        sArray() = Split(sRow, ";")
        ' Read to worksheet:
        Range("A1").Offset(5 + i).Resize(1, UBound(sArray)+1).Value = sArray
    Next cell
End Sub

Function ReplaceWhitespace(sInput As String) As String
    Dim sOutput As String
    ' Look for special cases with single-whitespace noise:
    sOutput = Replace(sInput, "- -", "-;-") ' Take care of "----- ----"
    sOutput = Replace(sOutput, "UNASSIGNED", ";UNASSIGNED;")
    ' Look for patterns where the number of "noise" characters is a prime number:
    sOutput = Replace(sOutput, "       ", ";") ' 7 whitespaces
    sOutput = Replace(sOutput, "     ", ";") ' 5
    sOutput = Replace(sOutput, "   ", ";") ' 3
    sOutput = Replace(sOutput, "  ", ";") ' 2
    ' sOutput = Replace(sOutput, " ", "_") ' 1 Optional
    sOutput = Replace(sOutput, ";;;;;", ";") ' 5 semicolons
    sOutput = Replace(sOutput, ";;;", ";") ' 3
    sOutput = Replace(sOutput, ";;", ";") ' 2
    sOutput = Replace(sOutput, "; ", ";") ' Takes care of some leftovers.
    ReplaceWhitespace = sOutput
End Function

Результат выполнения ParseUnstructured():