mail mail
Нужен макрос для Excel?
Сделайте заказ прямо сейчас!
Ищете готовое решение?
Выбирайте и покупайте!
У вас есть интернет-магазин?
Настроим парсер под любой сайт!

Преобразование строки со значениями в массив

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

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

И, если при исходных строках вида "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

Комментарии

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
   __     _____   _      _   __  __   _  __
/ /_ | ___| | | __ / | | \/ | | |/ /
| '_ \ | |_ | |/ / | | | |\/| | | ' /
| (_) | | _| | < | | | | | | | . \
\___/ |_| |_|\_\ |_| |_| |_| |_|\_\
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.