Excel 使用vba清除具有多个分隔符的数据

我有一个手动输入的票号列表，带有不同的分隔符和一些字符串。我正在尝试清理它，使票号以AK1开头，在一个字符串中用逗号分隔

多分裂 肮脏版本 在这个版本中，所有字符串都是使用一个单元格到另一个单元格的原则进行拆分和写入的

Sub MultiSplit()

    Const cDel As String = ";,/"  ' Delimiter List
    Const cCol1 As Variant = "A"  ' Source Column Letter/Number
    Const cCol2 As Variant = "B"  ' Target Column Letter/Number
    Const cDelR As String = ","   ' Replace Delimiter
    Const cFirstR As Long = 1     ' First Row Number

    Dim vntR As Variant   ' Range Array
    Dim vntD As Variant   ' Delimiter Array

    Dim LastR As Long     ' Last Row Number
    Dim i As Long         ' Range Array Row Counter
    Dim j As Long         ' Delimiter Array Row Counter

    ' Calculate Last Row Number.
    LastR = Cells(Rows.Count, cCol1).End(xlUp).Row

    ' Copy Source Range into Range Array.
    vntR = Range(Cells(cFirstR, cCol1), Cells(LastR, cCol1))

    ' Split Delimiter List into Delimiter Array
    vntD = Split(cDel, ",")

    ' Calculate values in Range Array.
    For i = 1 To UBound(vntR) ' Range Array
        For j = 0 To UBound(vntD) ' Delimiter Array
            ' Replace by overwriting.
            vntR(i, 1) = Replace(vntR(i, 1), vntD(j), cDelR)
        Next
    Next

    ' Copy Range Array to Target Range.
    Range(Cells(cFirstR, cCol2), Cells(LastR, cCol2)) = vntR

End Sub

清除一个字符串版本 如果您想将所有AK1票据放在一个单元格中，请使用以下命令 密码调整cDelC最终定界符以满足您的需要，例如aa、aa或aa、aa

Sub MultiSplit2()

    Const cDel As String = ";,/"     ' Delimiter List
    Const cCol1 As Variant = "A"     ' Source Column Letter/Number
    Const cCol2 As Variant = "B"     ' Target Column Letter/Number
    Const cDelR As String = ","      ' Replace Delimiter
    Const cFirstR As Long = 1        ' First Row Number
    Const cDelC As String = ", "     ' Clean Delimiter
    Const cString As String = "AK1"  ' Desired Start String

    Dim vntR As Variant   ' Range Array
    Dim vntD As Variant   ' Delimiter Array
    Dim vntT As Variant   ' Temporary Array

    Dim LastR As Long     ' Last Row Number
    Dim i As Long         ' Range Array Row Counter
    Dim j As Long         ' Delimiter Array Row Counter
    Dim strT As String    ' Target String


    ' Calculate Last Row Number.
    LastR = Cells(Rows.Count, cCol1).End(xlUp).Row

    ' Copy Source Range into Range Array.
    vntR = Range(Cells(cFirstR, cCol1), Cells(LastR, cCol1))

    ' Split Delimiter List into Delimiter Array
    vntD = Split(cDel, ",")

    ' Calculate values in Range Array.
    For i = 1 To UBound(vntR) ' Range Array
        For j = 0 To UBound(vntD) ' Delimiter Array
            ' Replace by overwriting.
            vntR(i, 1) = Replace(vntR(i, 1), vntD(j), cDelR)
        Next
        Debug.Print vntR(i, 1)
    Next

    ' Clean the strings in Range Array.
    For i = 1 To UBound(vntR)
        vntT = Split(vntR(i, 1), cDelR)
        For j = 0 To UBound(vntT)
            If Left(Trim(vntT(j)), Len(cString)) = cString Then
                If strT <> "" Then
                    strT = strT & cDelC & Trim(vntT(j))
                  Else
                    strT = Trim(vntT(j))
                End If
            End If
        Next
    Next

    ' Copy Target String to Target Cell.
    Cells(cFirstR, cCol2) = strT

End Sub

---

我建议使用UDF用户定义函数来实现这一点。在标准代码模块中安装下面的代码。按Alt+F11打开VB编辑器窗口。在左侧的Project explorer窗口中右键单击VBA项目，选择插入>模块，然后将代码粘贴到右侧的空代码面板中。请记住以启用xlsm宏的格式保存工作簿

Function ExtractAK1(Cell As Range) As String

    Const AK1 As String = "AK1-"

    Dim Var As Variant
    Dim Sp() As String
    Dim i As Integer

    Var = Cell.Value
    If VarType(Var) = vbString Then
        If InStr(1, Var, AK1, vbTextCompare) Then
            Sp = Split(Trim(Var), AK1)
            For i = 1 To UBound(Sp)
                Sp(i) = AK1 & Left(Trim(Sp(i)), 5)
            Next i
            Var = Join(Sp, ",")
            ExtractAK1 = Mid(Var, InStr(Var, ",") + 1)
        End If
    End If
End Function

调用工作表中的函数，就像调用内置Excel函数一样，例如

=ExtractAK1($A2)

如果安装正确，Excel将在您开始键入函数时提示函数名称$A2是包含文本的单元格。根据需要将公式复制下来。

---

如果这是一种更方便的使用方法，您可以将该函数重新指定用途，以便在循环中使用。

以下UDF将仅将您输入的内容提取到以逗号分隔的AK票号列表中。假设票号模式是AK-后面只跟数字，这就是您显示的。只提取车票号码，也提取你想要的

如果您输入单个字符串或单个单元格，这些内容将显示出来。 如果输入一系列单元格，它们将组合成一个输出字符串。 VBA的正则表达式引擎用于提取票号 使用单单元格版本：getAKA1:

使用多单元方法：

=getAK(A1:A12)

我们得到

AK1-97760,AK1-96767,AK1-97719,AK1-97999,AK1-98105,,AK1-97113,AK1-97073,AK1-97019,AK1-97951,AK1-97858,AK1-97195,AK1-96806,AK1-97719,AK1-97896,AK1-98115,AK1-98151,AK1-98089,AK1-96780,AK1-90919,AK1-96705,AK1-96806,AK1-95397

如果您还想返回票据的状态（票据编号后括号中的部分），可以将正则表达式更改为：

"\bAK1-\d+(?:\s*\([^)]+\))?"

---

如果您的票证模式不同，您也可以相应地修改正则表达式

AK编号的输出是否需要状态关闭，如果需要，模式在数据中是否一致，即AK编号和状态开始括号之间始终有空格。请花点时间查看，除了@QHarr注释外，您需要的输出示例将非常有用。如果没有工具将数据传输到Excel工作表中，您的数据截图对于正确进行故障排除几乎毫无用处。不得不手写对那些可能帮助你的人来说是令人沮丧的。为了使数据有用，请编辑您的问题，将其作为文本发布，可以使用此功能，也可以将删除了敏感信息的工作簿上载到某个公共网站，并在原始问题中发布链接

"\bAK1-\d+(?:\s*\([^)]+\))?"