Multi Split

Dirty Version

В этой версии все строки разделены и записаны с использованием принципа «одна ячейка в одну (другую) ячейку».

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

Версия Clean One String

Если вы хотите, чтобы все билеты 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