我们都知道正则表达式在查找特定类型的数据方面的强大功能,今天试着坐了一个可以筛选尾数为AAAAA,AAAA,AAA,BBBA,AABB,ABAB,ABBA,ABC,ABCD,ABCDE这十种情形的一个宏,欢迎大家批评指正。
程序运行时只需要点击clickme按钮即可。
代码如下:
Private Sub CommandButton1_Click()
tim = Timer
Range("b4:K65535").Clear '清除原来的区域
For i = 4 To [a65535].End(xlUp).Row + 1 '将所有手机号赋值给一个以逗号分隔的字符串。
istr = istr & "," & Cells(i, 1)
Next
sTr1 = RegExpTest("\d{6}([0-9])\1{4},", istr) '匹配AAAAA模式
sTr2 = RegExpTest("\d{6}([0-9])(?!\1)([0-9])\2{3},", istr) ’'匹配AAAA模式
sTr3 = RegExpTest("\d{7}([0-9])(?!\1)([0-9])\2{2},", istr) '匹配AAA模式
sTr4 = RegExpTest("\d{6}([0-9])(?!\1)([0-9])\2{2}(?!\2)([0-9]),", istr) '匹配AAAB模式
sTr5 = RegExpTest("\d{6}([0-9])(?!\1)([0-9])\2(?!\2)([0-9])\3,", istr) '匹配AABB模式
sTr6 = RegExpTest("\d{7}([0-9])(?!\1)([0-9])\1\2,", istr) '匹配ABAB模式
sTr7 = RegExpTest("\d{7}([0-9])(?!\1)([0-9])\2\1,", istr) '匹配ABBA模式
str8 = RegExpTest("\d{8}(012|123|234|456|567|678|789),", istr) '匹配ABC模式
str9 = RegExpTest("\d{7}(0123|1234|2345|4567|5678|6789),", istr) '匹配ABCD模式
str10 = RegExpTest("\d{6}(01234|12345|23456|45678|56789),", istr) '匹配ABCDE模式
For n = 0 To UBound(Split(str9, ",")) - 1 '清除模式ABC中的ABCD模式的手机号
str8 = Replace(str8, Split(str9, ",")(n) & ",", "")
Next
For n = 0 To UBound(Split(str10, ",")) - 1 ''清除模式ABC中的ABCDE模式的手机号
str8 = Replace(str8, Split(str10, ",")(n) & ",", "")
Next
Range("b4:b" & UBound(Split(sTr1, ",")) + 3) = Application.Transpose(Split(sTr1, ",")) '利用split函数将模式AAAA的手机号赋值给B列。下面同理
Range("c4:c" & UBound(Split(sTr2, ",")) + 3) = Application.Transpose(Split(sTr2, ","))
Range("d4:d" & UBound(Split(sTr3, ",")) + 3) = Application.Transpose(Split(sTr3, ","))
Range("e4:e" & UBound(Split(sTr4, ",")) + 3) = Application.Transpose(Split(sTr4, ","))
Range("f4:f" & UBound(Split(sTr5, ",")) + 3) = Application.Transpose(Split(sTr5, ","))
Range("g4:g" & UBound(Split(sTr6, ",")) + 3) = Application.Transpose(Split(sTr6, ","))
Range("h4:h" & UBound(Split(sTr7, ",")) + 3) = Application.Transpose(Split(sTr7, ","))
Range("i4:i" & UBound(Split(str8, ",")) + 3) = Application.Transpose(Split(str8, ","))
Range("j4:j" & UBound(Split(str9, ",")) + 3) = Application.Transpose(Split(str9, ","))
Range("k4:k" & UBound(Split(str10, ",")) + 3) = Application.Transpose(Split(str10, ","))
MsgBox Timer - tim
End Sub
Function RegExpTest(patrn, strng)
Dim regEx, Match, Matches ' Create variable.
Set regEx = CreateObject("VBSCRIPT.REGEXP") ' Create a regular expression.
regEx.Pattern = patrn ' Set pattern.
regEx.IgnoreCase = True ' Set case insensitivity.
regEx.Global = True ' Set global applicability.
Set Matches = regEx.Execute(strng) ' Execute search.
For Each Match In Matches ' Iterate Matches collection.
retstr = retstr & Match.Value
Next
RegExpTest = retstr
End Function
[本帖最后由 toopoor 于 2009-3-17 21:19 编辑]
2009-3-17 19:36 上传
点击文件名下载附件
67.8 KB, 下载次数: 272