楼主
天南地北 |
Q：如何将给定范围编号的地址转化为每一条记录？
如下图所示，将左边区域转换位右边黄色区域样式：
效果一：
效果二：
A：见如下代码，使用正则表达式分别提取区段的开始号码和结尾号码
效果一代码
- Sub 数据变换一()
- Dim reg As Object, arr(), arr2(1 To 10000, 1 To 1)
- Dim i%, j&, j1&, j2&, k%, str As String
- Set reg = CreateObject("VBScript.RegExp")
- arr = Range("a2:a" & Cells(Rows.Count, 1).End(3).Row)
- With reg
- For i = 1 To UBound(arr)
- .Global = True
- .Pattern = "\d+"
- '\d表示数字，等效于[0-9]，+表示一次或多次匹配前面的字符或子表达式，等效于 {1,}
- If InStr(arr(i, 1), "-") = 0 Then
- k = k + 1
- arr2(k, 1) = arr(i, 1)
- Else
- j1 = .Execute(arr(i, 1))(0): j2 = .Execute(arr(i, 1))(1)
- .Pattern = "\d+-\d+号" '表示数字 + - + 数字 + 号字的匹配
- str = .Replace(arr(i, 1), "")
- For j = j1 To j2
- k = k + 1
- arr2(k, 1) = str & j & "号"
- Next j
- End If
- Next i
- End With
- Range("b:b").ClearContents
- Range("b2").Resize(k) = arr2
- Range("b2").EntireColumn.AutoFit
- End Sub
效果二代码
- Sub 数据变换二()
- Dim reg As Object, arr(), arr2(1 To 10000, 1 To 255)
- Dim i%, j&, j1&, j2&, k%, l%, m%, str As String
- Set reg = CreateObject("VBScript.RegExp")
- arr = Range("a2:a" & Cells(Rows.Count, 1).End(3).Row)
- With reg
- For i = 1 To UBound(arr)
- .Global = True
- .Pattern = "\d+"
- k = k + 1
- If InStr(arr(i, 1), "-") = 0 Then
- arr2(k, 1) = arr(i, 1)
- Else
- j1 = .Execute(arr(i, 1))(0): j2 = .Execute(arr(i, 1))(1)
- .Pattern = "\d+-\d+号"
- str = .Replace(arr(i, 1), "")
- l = 0
- For j = j1 To j2
- l = l + 1
- arr2(k, l) = str & j & "号"
- Next j
- If m < l Then m = l
- End If
- Next i
- End With
- Range("b2").Resize(k, 255).ClearContents
- Range("b2").Resize(k, m) = arr2
- Range("b2").Resize(k, m).EntireColumn.AutoFit
- End Sub
PS：正则表达式常见用法其实很简单，WORD查找替换就有部分正则的影子，具体语法可以参考下面链接，在附件中也提供了。
关于正则表达式语法可以参考以下链接：
http://msdn.microsoft.com/zh-cn/library/ae5bf541(v=vs.100).aspx
 数据变换.rar
|