Преобразование списка номеров и названий столбцов в массив значений

Private Sub ПримерИспользования_ParseColumnsStringEx()
    Dim txt$, txt1$, txt2$
    ' исходная строка с номерами столбцов (c ошибками ввода)
    txt$ = "4-4 , -a- C;8,Я-7,-11-9-F, Е --К; 4,21-,6-F"
 
    ' получаем массив столбцов
    arr = ParseColumnsStringEx(txt)
 
    ' выводим список столбцов:  4,1,2,3,8,7,11,10,9,8,7,6,5,6,7,8,9,10,11,4,21,6,
    For i = LBound(arr) To UBound(arr): Debug.Print arr(i) & ",";: Next i: Debug.Print
 
    ' ======================================
    ' или, например, такая строка
    txt$ = "4-5,8 -k, 6-5;a,e,3,4, 46-BA"
 
    ' получаем массив столбцов (c «промежуточными» значениями)
    arr2 = ParseColumnsStringEx(txt, txt1, txt2)
 
    Debug.Print txt1    ' выводит  4-5;8-K;6-5;A;E;3;4;46-BA
    Debug.Print txt2    ' выводит  4-5,8-11,6-5,1,5,3,4,46-53
    columnsList$ = Join(arr2, ",")
    Debug.Print columnsList$    ' выводит 4,5,8,9,10,11,6,5,1,5,3,4,46,47,48,49,50,51,52,53
End Sub

Function ParseColumnsStringEx(ByVal txt$, Optional ByRef norm1$, Optional ByRef norm2$) As Variant
    ' Принимает в качестве параметра строку типа "A-C;8,,11-9, Е-К; 4,21,"
    ' Возвращает одномерный (горизонтальный) массив в формате Array(1,2,3,8,11,10,9,5,6,7,8,9,10,11,4,21)
    ' (пустые значения удаляются; диапазоны типа 9-15 и 17-13 раскрываются,
    '  буквенные диапазоны заменяются на числовые, русские буквы заменяются латинскими)

    On Error Resume Next
    ' устраняем возможные ошибки пользовательского ввода
    Const enARR$ = "ABCEHKMOPTX", ruARR$ = "АВСЕНКМОРТХ"
    Const cc& = 256      ' ограничение на максимальный номер столбца
    For i = 1 To Len(enARR$): txt = Replace(txt, Mid(ruARR$, i, 1), Mid(enARR$, i, 1)): Next i
    txt = Replace(txt, " ", ""): txt = Replace(txt, ";", ",")
    txt = Replace(txt, ":", "-"): txt = Replace(txt, ".", ","): txt = UCase(txt)
    For i = 1 To Len(txt)
        If Not Mid(txt, i, 1) Like "[A-Z0-9,-]" Then Mid(txt, i, 1) = ","
    Next i
    While InStr(1, txt, ",,"): txt = Replace(txt, ",,", ","): Wend
    While InStr(1, txt, "--"): txt = Replace(txt, "--", "-"): Wend
    txt = Replace(txt, ",-", ","): txt = Replace(txt, "-,", ",")
    If Left(txt, 1) = "-" Or Left(txt, 1) = "," Then txt = Mid(txt, 2)
    If Right(txt, 1) = "-" Or Right(txt, 1) = "," Then txt = Left(txt, Len(txt) - 1)
    norm1$ = Replace(txt$, ",", ";")  ' возвращаем «нормализованную» строку для подстановки в поле

    arr = Split(txt$, ","): Dim n As Long: ReDim tmpArr(0 To 0)
    For i = LBound(arr) To UBound(arr)
        spl = Split(arr(i), "-")
        For j = LBound(spl) To UBound(spl)
            cn& = 0: cn& = ColumnNameToColumnNumber(spl(j)): If cn& Then spl(j) = cn&
            If Not spl(j) Like String(Len(spl(j)), "#") Then spl(j) = ""
        Next j
        If Val(spl(0)) > cc& Then spl(0) = "": spl(UBound(spl)) = ""
        If Val(spl(UBound(spl))) > cc& Then spl(UBound(spl)) = cc&
        If UBound(spl) > 1 Then arr(i) = spl(0) & "-" & spl(UBound(spl)) Else arr(i) = Join(spl, "-")
        If UBound(spl) = 1 Then If spl(0) = spl(1) Then arr(i) = spl(0)
        If UBound(spl) = 1 Then If spl(0) = "" Then arr(i) = spl(1)
    Next i
    norm2$ = Join(arr, ","): norm2$ = Replace(norm2$, ",-", ","): norm2$ = Replace(norm2$, "-,", ",")
    While InStr(1, norm2$, ",,"): norm2$ = Replace(norm2$, ",,", ","): Wend
    If Left(norm2$, 1) = "," Then norm2$ = Mid(norm2$, 2)
    If Right(norm2$, 1) = "," Then norm2$ = Left(norm2$, Len(norm2$) - 1)
 
    For i = LBound(arr) To UBound(arr)
        Select Case True
            Case arr(i) = "", Val(arr(i)) < 0
            Case IsNumeric(arr(i))
                tmpArr(UBound(tmpArr)) = arr(i): ReDim Preserve tmpArr(0 To UBound(tmpArr) + 1)
            Case arr(i) Like "*#-#*"
                spl = Split(arr(i), "-")
                If UBound(spl) = 1 Then
                    If IsNumeric(spl(0)) And IsNumeric(spl(1)) Then
                        If spl(0) <= cc& Then
                            If spl(1) > cc& Then spl(1) = cc&
                            For j = Val(spl(0)) To Val(spl(1)) Step IIf(Val(spl(0)) > Val(spl(1)), -1, 1)
                                tmpArr(UBound(tmpArr)) = j: ReDim Preserve tmpArr(0 To UBound(tmpArr) + 1)
                            Next j
                        End If
                    End If
                End If
        End Select
    Next i
    If UBound(tmpArr) Then
        ReDim Preserve tmpArr(0 To UBound(tmpArr) - 1)
        ParseColumnsStringEx = tmpArr
    End If
End Function
 
Function ColumnNameToColumnNumber(ByVal txt$) As Long
    On Error Resume Next    ' преобразует имя столбца в номер.   в случае ошибки возвращает 0
    ColumnNameToColumnNumber = Split(Application.ConvertFormula(txt$ & "1", xlA1, xlR1C1, True), "C")(1)
End Function