如何将文本/信息的特定部分从一个单元格传输到多个相应的单元格？

Question

我需要帮助从一个单元格中获取文本的特定部分并将其转移到其他几个单元格中。在“杆信息”类别下，每个类别的字符数量/类型（杆类型、图纸代码和瑕疵/废料/空白）每次都会发生变化。

在 Pole Info 列中，例如：V49084RAU 17.5 54323 49F 214 2273 BlEMISH

第一个文本块中的前 5 个数字 (49084) 是输入为 490/84 的杆类型

下一个信息块 (17.5) 是 Flex Number。有时，弹性编号也可能出现在第一个文本块中。

第三或第四信息块（49F）是图纸代码。有时可能会超过 3 个字符，甚至全是字母。

下一个信息块（2273）是重量。有时这可能是 3 个数字。

最后，信息的最后一个块可以包含 BLEMISH、SCRAP 或空白。这需要进入相应的列（是废品，是瑕疵，或者两列都需要说“否”或留空）

杆信息有多种变体，因此我将提供示例。第 3 行是正确行的示例：()

我尝试在每个单独的单元格中使用公式，但由于极点信息信息的格式不同，因此很难使其稳健。我不确定用 VBA 来做这件事是否会更好，但我很困惑如何开始，因为我对 VBA 缺乏经验。

到目前为止，我已经使用 =IFERROR(LEFT(B2, FIND(" ", B2)-1), G2) 作为杆类型，但不知道剩下的该怎么做。

Answer 1

Option Explicit

Sub Demo()
    Dim i As Long, j As Long
    Dim arrData, rngData As Range, arrRes
    Dim objRegExp As Object, objMatch As Object
    Const COL_CNT = 7
    ' Create RegExp object
    Set objRegExp = CreateObject("vbscript.regexp")
    objRegExp.Pattern = "[a-z]+(\d{3})(\d\d)[a-z]+\s*([\d\.]+)\s+\d+\s+(.*?)\s+(\d+)\s+(\d+)(?:\s+([a-z]+))*"
    objRegExp.Global = True
    objRegExp.IgnoreCase = True
    ' Load data
    Set rngData = Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row)
    arrData = rngData.Value
    ReDim arrRes(1 To UBound(arrData), 1 To COL_CNT)
    ' Loop through data
    For i = LBound(arrData) To UBound(arrData)
        Set objMatch = objRegExp.Execute(arrData(i, 1))
        ' Load ouput
        If objMatch.Count > 0 Then
            With objMatch(0)
                arrRes(i, 1) = .submatches(0) & "/" & .submatches(1)
                arrRes(i, 2) = "'" & .submatches(3)
                arrRes(i, 3) = "'" & .submatches(2)
                arrRes(i, 4) = "'" & .submatches(4)
                arrRes(i, 5) = "'" & .submatches(5)
                If .submatches.Count > 5 Then
                    If StrComp(.submatches(6), "SCRAP", vbTextCompare) = 0 Then
                        arrRes(i, 6) = "SCRAP"
                    ElseIf StrComp(.submatches(6), "BLEMISH", vbTextCompare) = 0 Then
                        arrRes(i, 7) = "BLEMISH"
                    End If
                End If
            End With
        End If
    Next i
    ' Write output to sheet
    Range("C2").Resize(UBound(arrData), COL_CNT).Value = arrRes
End Sub