Excel或VBA将非结构化文本转换为列

如果文本是非结构化的，没有正确的分隔符，如何将文本转换为列

例如，如何翻转以下行：

变成类似于：

在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，我得到了更多期望值，如：

我还尝试替换选项卡（如果它存在的话），如下所示：

但也不管用

---

还有其他方法吗？

这里尝试使用一个自定义的

ReplaceWhitespace

函数，该函数根据空格的长度依次替换空格部分。作为中间步骤，将空格替换为分号；最后一步是删除不必要的分号

Split

将解析后的字符串拆分为数组，然后将结果读取到工作表中。根据您的具体需要调整

ReplaceWhitespace

应该很简单

请注意，此算法不评估单个空白字符的实例是否应被视为噪声（如“未指定的管线”）或ar作为有效字delimter（如“单位成本”）。因此，在

ReplaceWhitespace

：

“-”~~>“-；-”

和

“UNASSIGNED”~>“UNASSIGNED；”中，作为噪声的单个空白被视为特殊情况

假设屏幕截图中的数据位于范围
A1:A4
，则此代码或多或少会产生所需的输出，如下面的屏幕截图所示

编辑：替换空白的初始设计基于反复试验。经过一点思考，我意识到，在寻找字符数为素数的模式的算法中，空格字符数或分号数为a的模式将由那些行处理。我已经相应地更新了代码

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（）
的结果：

假设类别只能是几个定义的单词中的一个，那么您提供的数据确实有一个规则模式

如果类别永远只是一个单词，那么也可以假设UOM只有几个定义的单词。比如说


项：第一个子字符串后跟空格
描述：词数可变，后跟类别
类别：来自定义的单词列表
计量单位：从定义的单词列表中
剩下的都是空间分隔的

根据该模式，我们可以构造一个正则表达式，并在VBA宏中使用该正则表达式来拆分行。
当然，如果模式与此不同，该方法将不起作用。但您必须提供包含所有可变性的示例

下面的宏假定类别将是
已分配的
或
未分配的
，但您可以在代码中的管道分隔列表中添加更多单词

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

代码中还包含其他假设

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

您可能需要使用文本编辑器和正则表达式插入
文本限定符
（
“
或
”
）围绕组合在一起的单词。如果数据中没有逗号，另一个选项是将文本转换为csv。感谢@Ron Rosenfeld，这似乎有效。我发现正则表达式有点混乱，似乎每次出现新词时都需要更新类别字段。是否可以将正则表达式代码更改为固定空格就像第二行中用“-”来定义的一样？@Selrac可能可以。或者如果
Category
只是一个词，那么使用
UOM
作为标记可能会更简单。但是既然@egalth的方法对你有用，我就坚持下去。不客气。我想我只用了几分钟就破解了它，直到我意识到了问题由于不知道一个空格是否为噪波而产生的额外复杂性。将单个字符空格噪波视为特例似乎是一个有效的解决方案，但我也很想看到其他解决方案（至于Regex方法，我注意到对于大型数据集，它可能会变得非常缓慢）@Selrac，请注意我关于如何通过删除冗余状态来进一步简化代码的更新。我缺少最后一列（运费）。我已使用以下命令更正了缺少的列：Range（“A1”）。Offset（LastRowR）。Resize（1，UBound（sArray）+1）。Value=sArray谢谢，很抱歉我遗漏了它。