Ситуация: дана строка, в которой через запятую перечислены значения (или диапазоны значений)

Требуется подсчитать, сколько значений содержится в строке, или же разбить строку на массив, содержащий все значения из исходной строки.

И, если при исходных строках вида "5,6,8,18,2,21" всё просто (достаточно применить VB-функцию Split), то при наличии в строке диапазонов значений вида Число1-Число2 (например, строка "9-15,18,2,11-9") задача заметно усложняется.

В этих случаях на помощь придёт функция ArrayOfValues

Function ArrayOfValues(ByVal txt$) As Variant

' Принимает в качестве параметра строку типа ",,5,6,8,,9-15,18,2,11-9,,1,4,,21,"

    ' Возвращает одномерный (горизонтальный) массив в формате

    ' array(5,6,8,9,10,11,12,13,14,15,18,2,11,10,9,1,4,21)

    ' (пустые значения удаляются; диапазоны типа 9-15 и 17-13 раскрываются)

arr = Split(Replace(txt$, " ", ""), ","): Dim n As Long: ReDim tmpArr(0 To 0)

    For i = LBound(arr) To UBound(arr)

        Select Case True

            Case arr(i) = "", Val(arr(i)) < 0

                '  раскомментируйте эту строку, чтобы пустые и нулевые значения

                '  тоже добавлялись в результат (преобразовывались в значение -1)

                'tmpArr(UBound(tmpArr)) = -1: ReDim Preserve tmpArr(0 To UBound(tmpArr) + 1)

            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

                        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 Select

    Next i

    On Error Resume Next: ReDim Preserve tmpArr(0 To UBound(tmpArr) - 1)

    ArrayOfValues = tmpArr

End Function

Использовать её можно так:

Sub ПримерИспользования()

    ' разбиваем строку в массив, содержащий все значения исходной строки

    a = ArrayOfValues(",,5,6,8,,9-15,18,2,11-9,,1,4,,21,")

    Debug.Print Join(a, ",") ' объединяем обратно созданный массив

    ' результатом будет строка "5,6,8,9,10,11,12,13,14,15,18,2,11,10,9,1,4,21"

End Sub

Функция нашла применение в программе выгрузки тарифов в XML

Ещё один вариант функции, только она возвращает из аналогичной текстовой строки КОЛЛЕКЦИЮ НЕПОВТОРЯЮЩИХСЯ чисел от 1 до 255

Function ArrayOfValuesEx(ByVal txt$) As Collection

    ' Принимает в качестве параметра строку типа ",,5,6,8,,9-15,18,2,11-9,,1,4,,21,"

    ' Возвращает колекцию уникальных чисел в формате    (5,6,8,9,10,11,12,13,14,15,18,2,1,4,21)

    ' (удаляются все значения кроме целых чисел от 1 до 255; диапазоны типа 9-15 и 17-13 раскрываются)

    On Error Resume Next: Set ArrayOfValuesEx = New Collection

    MaxNumber& = 255

    txt = Replace(Replace(txt, ".", ","), " ", "")

    For i = 1 To Len(txt)

        If Mid(txt, i, 1) Like "[0-9,-]" Then res = res & Mid(txt, i, 1) Else res = res & " "

    Next

    txt = Replace(res, " ", "")

    arr = Split(txt, ","):

    For i = LBound(arr) To UBound(arr)

        Select Case True

            Case arr(i) = "", Val(arr(i)) < 0

            Case IsNumeric(arr(i))

                v& = Val(arr(i)): If v > 0 And v <= MaxNumber& Then ArrayOfValuesEx.Add v, CStr(v)

            Case arr(i) Like "*#-#*"

                spl = Split(arr(i), "-")

                If UBound(spl) = 1 Then

                    If IsNumeric(spl(0)) And IsNumeric(spl(1)) Then

                        For j = Val(spl(0)) To Val(spl(1)) Step IIf(Val(spl(0)) > Val(spl(1)), -1, 1)

                            v& = j: If v > 0 And v <= MaxNumber& Then ArrayOfValuesEx.Add v, CStr(v)

                        Next j

                    End If

                End If

        End Select

    Next i

End Function

Private Sub ArrayOfValuesEx_ПримерИспользования()

    ' разбиваем строку в массив, содержащий все значения исходной строки

    Dim coll As Collection

    Set coll = ArrayOfValuesEx(",,5,6,+8,,9-12,18//,2,11-9,,1,4.6,,21,7a,ajsgh55,4-")

    For Each Item In coll: Debug.Print Item;: Next: Debug.Print

    ' результатом будет   5  6  8  9  10  11  12  18  2  1  4  21  7  55

End Sub

• 14030 просмотров