使用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, "")

但是它也没有起作用。

还有其他方法可以尝试吗？

- Selrac

---

你可能需要使用文本编辑器和正则表达式来插入一个“文本限定符”（"或'）来将一起的单词括起来。另一个选项是，如果数据中没有逗号，则可以将文本转换为CSV格式。 - cybernetic.nomad

Answer 1

这里是使用自定义的ReplaceWhitespace函数的尝试，它根据它们的长度依次替换空格部分。作为中间步骤，空格被替换为分号；不必要的分号作为最后一步被删除。 Split 用于读取已解析的字符串到一个数组中，该数组用于将结果读取到工作表中。很容易针对您的具体需求调整ReplaceWhitespace。请注意，此算法不评估单个空格字符实例是否应视为噪音（如“TUBELINES UNASSIGNED”）或作为有效单词分隔符（如“Unit Cost”）。因此，在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()的结果：

- Egalth

---

不用谢。起初我认为只用几分钟就能解决，直到意识到由于不知道一个单独的空格是噪声还是不是噪声而带来的额外复杂性问题。将单字符空白视为特殊情况似乎是一种有效的解决方案，但我也很想看看其他解决方案。 （至于正则表达式方法，我注意到它在大型数据集上可能会变得非常慢。） - Egalth

@Selrac，请注意我对代码如何进一步简化的更新，通过删除冗余语句。 - Egalth

我缺少最后一列（运费）。 - Selrac

我已经通过以下方式纠正了缺失的列：Range("A1").Offset(LastRowR).Resize(1, UBound(sArray) + 1).Value = sArray - Selrac

谢谢，抱歉我错过了。 - Egalth

Answer 2

你提供的数据有规律，假设“类别”仅为几个定义好的单词之一。

如果“类别”只是一个单词，我们也可以假设“计量单位”只有几个定义好的单词。例如：

- 项目：第一个子字符串后面跟一个空格 - 描述：可变数量的单词后面跟着“类别” - 类别：从定义好的单词列表中选取 - 计量单位：从定义好的单词列表中选取 - 其余部分均以空格分隔

基于这种模式，我们可以构建一个正则表达式，并在VBA宏中使用它来拆分行。当然，如果模式与此不同，则该方法将无法使用。但您必须提供涵盖所有可变性的示例。

下面的宏假定“类别”将是“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

- Ron Rosenfeld

---

谢谢@Ron Rosenfeld，看起来这个方法可行。我觉得正则表达式有点混乱，似乎每次出现新单词都需要更新类别字段。是否可能更改正则表达式代码以在固定空格上工作，就像第二行中定义的“-”一样？ - Selrac

@Selrac 可能可以。或者如果“Category”只有一个单词，使用“UOM”作为标记可能会更简单。但既然 @egalth 的方法对您有效，我建议您继续使用它。 - Ron Rosenfeld