我有一个电子表格,显示了不同的区域组。
+---------------------------------+
| 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:添加了更长的区域字符串以进行演示。
答案 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
答案 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
注释
A2
C2
开始放置输出运行代码:
ALT + F11
Insert
> Module
。剪切并粘贴代码AreaParser
中按F5