Извлечь все числа в строку, содержащую диапазоны и числа

Question

У меня есть электронная таблица, которая показывает разные группы областей.

+---------------------------------+
|              Area               |
+---------------------------------+
|                       111/01-02 |
|         111/03-06 and 112/07-09 |
|               111/06 and 111/10 |
|    111/11, 112/01 and 112/05-06 |
+---------------------------------+

Как извлечь все коды областей из строки листа 1?Например, от 111/03-05 and 112/07-09 до 111/03, 111/04, 111/05, 112/07, 112/08, 112/09.

Идеальным выходом будет:

+---------------------------------+------------+
|          Area String            |    Area    |
+---------------------------------+------------+
|                       111/01-02 |     111/01 |
|                       111/01-02 |     111/02 |
|         111/03-05 and 112/07-09 |     111/03 |
|         111/03-05 and 112/07-09 |     111/04 |
|         111/03-05 and 112/07-09 |     111/05 |
|         111/03-05 and 112/07-09 |     112/07 |
|         111/03-05 and 112/07-09 |     112/08 |
|         111/03-05 and 112/07-09 |     112/09 | 
|               111/06 and 111/10 |     111/06 |
|               111/06 and 111/10 |     111/10 |
|    111/11, 112/01 and 112/05-06 |     111/11 |
|    111/11, 112/01 and 112/05-06 |     112/01 |
|    111/11, 112/01 and 112/05-06 |     112/05 |
|    111/11, 112/01 and 112/05-06 |     112/06 |
+---------------------------------+------------+

Спасибо!

Редактировать: обновлена ​​таблица строк области, которая содержит другой префикс, а не унифицированный префикс.

Edit2: добавлены более длинные строки области для демонстрации.

Answer 1

Вы можете попробовать это.

Sub AreaParser()
    Dim Areas As Range, area As Range

    Set Areas = Range("A2:A5")

    For Each area In Areas
        If InStr(area, "and") = 0 Then
            IterateAreas CStr(area), CStr(area)
        Else
            IterateAreas CStr(area), CStr(VBA.Split(area, "and")(0))
            IterateAreas CStr(area), CStr(VBA.Split(area, "and")(1))
        End If
    Next area

End Sub

Sub IterateAreas(original As String, area As String)
    Dim stem As String, low As Integer, high As Integer, rw As Integer

    If InStr(area, "-") = 0 Then   '~~> Case: "111/06"
        stem = VBA.Left$(area, InStr(area, "/") - 1)
        low = VBA.Right$(area, VBA.Len(area) - InStr(area, "/"))
        high = low
    End If

    If InStr(area, "-") <> 0 Then  '~~> Case: "111/01-02"
        stem = VBA.Left$(area, InStr(area, "/") - 1)
        low = VBA.Split(VBA.Right$(area, VBA.Len(area) - InStr(area, "/")), "-")(0)
        high = VBA.Split(VBA.Right$(area, VBA.Len(area) - InStr(area, "/")), "-")(1)
    End If

    rw = Range("D" & Rows.Count).End(xlUp).row + 1

    For i = low To high
        Range("C" & rw) = VBA.Trim(original)
        Range("D" & rw) = VBA.Trim(stem & "/" & IIf(i < 10, "0" & i, i))
        rw = rw + 1
    Next i
End Sub

Примечания

1. Предполагается, что ваши входные данные начинаются с A2
2. Помещает вашвыходной сигнал начинается с C2

Для запуска кода:

1. Нажмите ALT + F11
2. Insert> Module.Вырежьте и вставьте код
3. В AreaParser нажмите F5

Answer 2

Объяснение в комментариях к коду.

Option Explicit

Sub areaFromAreaString()

    Dim a As Variant, z As Variant, x As Variant, y As Variant
    Dim i As Long, j As Long, k As Long, m As Long
    Dim split1 As String, split2 As String, split3 As String, comma As String

    'define split delimiters
    split1 = " and "
    split2 = "-"
    split3 = "/"
    comma = ", "

    With Worksheets("sheet3")

        'get areas from worksheet
        a = .Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp))

        'prep target array
        ReDim z(1 To 2, 1 To 1) As Variant
        z(1, 1) = "Area String"
        z(2, 1) = "Area"

        'loop through source areas
        For i = LBound(a, 1) To UBound(a, 1)

            'homogenize group delimiters
            a(i, 1) = Replace(a(i, 1), comma, split1)

            'primary split loop
            For Each x In Split(a(i, 1), split1)

                'get hi/lo split by hyphen, default to samevalue if no hyphen
                j = Val(Split(Split(x, split3)(1), split2)(LBound(Split(Split(x, split3)(1), split2))))
                k = Val(Split(Split(x, split3)(1), split2)(UBound(Split(Split(x, split3)(1), split2))))

                'fill in gaps
                For m = j To k
                    ReDim Preserve z(1 To 2, 1 To UBound(z, 2) + 1)
                    z(1, UBound(z, 2)) = a(i, 1)
                    z(2, UBound(z, 2)) = Split(x, split3)(0) & split3 & Format(m, "00")
                Next m

            Next x
        Next i

        'stuff values back onto worksheet
        With .Cells(1, "B").Resize(UBound(z, 2), UBound(z, 1))
            .NumberFormat = "@"
            .Value = Application.Transpose(z)
        End With

    End With
End Sub