Question

首先，我也想根据特定的单词拆分文本。然后，我要自动将文本一一分割。

1 ID001公司名称：ABC有限公司地址：Central ID002公司名称：Delino公司地址：旺角ID003公司名称：Moria公司地址：Shatin ID004公司名称：Sherlyn公司地址：旺角ID005公司名称：Coco公司地址：沙田

2 ID010公司名称：Toro有限公司地址：Central ID012公司名称：Benz公司地址：旺角ID013公司名称：Korz公司地址：Shatin ID014公司名称：Chopra公司地址：Mong Kok ID015公司名称：Toto公司地址：沙田

我尝试使用vba。

io.Copy

之前：

之后：

Answer 1

您可以尝试这样的事情...

如果代码不是Sheet1，请记住在测试代码之前先更改数据表。

Sub SplitText()
Dim wsData As Worksheet, dws As Worksheet
Dim rng As Range, cel As Range
Dim FullName() As String
Dim lr As Long, i As Long, dlr As Long
Dim str()

Set wsData = Sheets("Sheet1")   'Sheet with Data
lr = wsData.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = wsData.Range("A1:A" & lr)

Set dws = Worksheets.Add

For Each cel In rng
    FullName = Split(cel.Value, "ID")
    ReDim str(1 To UBound(FullName), 1 To 2)
    For i = 1 To UBound(FullName)
        str(i, 1) = "ID" & Left(FullName(i), InStr(FullName(i), " ") - 1)
        str(i, 2) = VBA.Trim(Right(FullName(i), Len(FullName(i)) - 3))
    Next i

    If dws.Range("A1").Value = "" Then
        dlr = 1
    Else
        dlr = dws.Cells(Rows.Count, 1).End(xlUp).Row + 1
    End If
    dws.Range("A" & dlr).Resize(UBound(str, 1), 2).Value = str
    Erase str
Next cel
End Sub

Answer 2

您可以使用正则表达式来执行此操作。以下内容将匹配您在两个“ ID”块之间或“ ID”与行尾之间的范围内的所有值

Public Sub RegExDemo()
    Dim RegExp As Object
    Dim arr As Variant
    Dim submatches, match, matches
    Dim RowIndex As Long, j As Long
    Dim c

    With Sheet2
        arr = .Range(.Cells(1, 1), .Cells(2, 1)).Value2
    End With

    Set RegExp = CreateObject("vbscript.regexp")

    With RegExp
        .Global = True
        .ignorecase = False
        .MultiLine = True
        .Pattern = "(ID[0-9]{1,}) (.*?)(?= ID[0-9]{1,}|$)"

        RowIndex = 1

        For Each c In arr
            If .test(c) Then
                Set matches = .Execute(c)
                For Each match In matches
                    Set submatches = match.submatches
                    For j = 0 To submatches.Count - 1
                        ActiveSheet.Cells(RowIndex, 1).Offset(0, j).Value2 = Trim(submatches(j))
                    Next j
                    RowIndex = RowIndex + 1
                Next match
            End If
        Next c
    End With

    With ActiveSheet
        With .Range(.Cells(1, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 2))
            .Columns.AutoFit
            .Rows.AutoFit
        End With
    End With
End Sub

制作：

用特定的单词分割文本+文本换行

2 个答案: