提取包含范围和数字的字符串中的所有数字

时间:2019-04-07 04:48:38

标签: excel

我有一个电子表格,显示了不同的区域组。

+---------------------------------+
|              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-09111/03111/04111/05112/07112/08112/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:添加了更长的区域字符串以进行演示。

2 个答案:

答案 0 :(得分:0)

代码注释中的说明。

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

enter image description here

答案 1 :(得分:0)

您可以尝试一下。

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