Ситуация: дана строка, в которой через запятую перечислены значения (или диапазоны значений)
Требуется подсчитать, сколько значений содержится в строке, или же разбить строку на массив, содержащий все значения из исходной строки.
И, если при исходных строках вида "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
Комментарии
Отправить комментарий