用于截断单元格中的多行文本的宏

Question

我在特定列的单元格中有一个多行文本，其中有数字后跟制表符分隔符，我希望处理下面的文件，请参阅 SHEET 的名称

LINK TO FILE

实际数据超过1000行，要在新插入的列中生成结果输出1和2。

任何人都可以帮助我使用宏在特定列“ABC”上运行，并且只保留制表符之前的文本和连接两个下一个字符文本的另一列。此外，此 ABC 列可以更改 Excel 表中的位置，如果有人可以帮助我，我将非常感激。

我很震惊的代码是

Sub RahulSplit()
Dim colNum As Integer
    colNum = ActiveSheet.rows(1).Find(what:="ABC", lookat:=xlWhole).Column
        ActiveSheet.Columns(colNum + 1).Insert
        ActiveSheet.Cells(1, colNum + 1).Value = "Results 2 Anticipated"

    With CreateObject("VBScript.RegExp")
        .Global = True
        .MultiLine = True
        .Pattern = "\w*\t\w*\s"
        Dim x
        For Each x In .Execute(s)
            InBrackets = InBrackets & Mid(x, 2, Len(x) - 2) & vbLf
        Next
    End With

EndSub

Answer 1

您可以使用此 UDF 提取由[...] 括号括起来的字符串：

Function InBrackets(s As String) As String
    With CreateObject("VBScript.RegExp")
        .Global = True
        .MultiLine = True
        .Pattern = "\[\w*\]"
        Dim x
        For Each x In .Execute(s)
            InBrackets = InBrackets & Mid(x, 2, Len(x) - 2) & vbLf
        Next
    End With
End Function

用法：

B2：=InBrackets(A2)

编辑

好的，所以在你更好地指定了你的目标之后，与括号无关，试试下面的：

Sub InsertAnticipatedResults(sh As Worksheet)
    Dim colABC As Long, abc As Range
    With sh
        colABC = .Rows(1).Find(what:="ABC", lookat:=xlWhole).Column
        .Columns(colABC + 1).Insert
        .Cells(1, colABC + 1).value = "Results 1 Anticipated"

        .Columns(colABC + 2).Insert
        .Cells(1, colABC + 2).value = "Results 2 Anticipated"

        Set abc = .Range(.Cells(2, colABC), .Cells(.Rows.Count, colABC).End(xlUp))
    End With

    Dim res1 As String, res2 As String, result1 As String, result2 As String, x
    With CreateObject("VBScript.RegExp")
        .Global = True
        .MultiLine = True
        .Pattern = "^\S*\s*\S*\s"
        For Each abc In abc.Cells
            result1 = "": result2 = ""
            For Each x In .Execute(abc.Text)
                res2 = Trim(x)
                res1 = Trim(Left(res2, Len(res2) - 2))
                res2 = Replace(res2, " ", "")
                res2 = Replace(res2, vbTab, "")

                If Len(result1) > 0 Then result1 = result1 & vbLf: result2 = result2 & vbLf
                result1 = result1 & res1
                result2 = result2 & res2
            Next
            abc.Offset(, 1).value = result1
            abc.Offset(, 2).value = result2
        Next
    End With
End Sub

Sub Testing()
    InsertAnticipatedResults ActiveSheet
End Sub