昨天收到一个需求，根据要求生成每个号码的等级（图片）
下面是最后做出的效果
下面是 VBA 代码
‘ 作者：梁茂业 2019 年 3 月 7 日
Sub replacePhone1()
‘ 定义起始行
START_ROW = 2
‘ 定义等级
Dim Rng2
Dim level
Dim level_1
Dim level_2
Dim level_3
level_1 = Array(1, 2, 1, 2, 3, 3, 4, 5, 4, 5, 7)
level_2 = Array(0, 1, 1, 2, 3, 1, 2, 3, 3, 4, 5)
level_3 = Array(0, 0, 1, 2, 3, 1, 2, 3, 3, 4, 5)
Set regx = CreateObject(“vbscript.regexp”)
regx.Global = True
Set Rng = Range(“a3:a” & Cells(Rows.Count, 1).End(xlUp).Row)
Rng2 = Sheet2.Range(“a2:g” & Sheet2.Cells(Rows.Count, 1).End(xlUp).Row)
For Each rn In Rng
n = n + 1
‘ 基础匹配 是否是手机号
regx.Pattern = “^1\d{10}$”
If regx.Test(rn.Value) Then
‘ 判断号码级别
level = level_3
regx.Pattern = “^(1380772|1380782|1390772|1390782|1980772|1987720|1987722|1987723|1987724|1987725|1987726|1987727|1987728|1987729)”
‘ 第一级
If regx.Test(rn.Value) Then
level = level_1
End If
regx.Pattern = “^(1350772|1360772|1387720|1387721|1387722|1387723|1387724|1387725|1387726|1387727|1387728|1387729|1387820|1387821|1387822|1387823|1387824|1387825|1387826|1387827|1387828|1387829|1397720|1397721|1397722|1397723|1397724|1397725|1397726|1397727|1397728|1397729|1397820|1397821|1397822|1397823|1397824|1397825|1397826|1397827|1397828|1397829|)”
‘ 第二级
If regx.Test(rn.Value) Then
level = level_2
End If
‘ 判断局向
n2 = 0
For i = 1 To UBound(Rng2, 1)
n2 = n2 + 1
n3 = Rng2(n2, 3)
n4 = Rng2(n2, 4)
If rn.Value >= Rng2(n2, 3) And rn.Value <= Rng2(n2, 4) Then
Cells(n + START_ROW, 3) = Rng2(n2, 7)
GoTo area
End If
Next
area:
‘ 尾数顺位 9 位
regx.Pattern = “(?:0(?=1)|1(?=2)|2(?=3)|3(?=4)|4(?=5)|5(?=6)|6(?=7)|7(?=8)|8(?=9)){8}\d”
If regx.Test(Right(rn.Value, 9)) Then
Cells(n + START_ROW, 4) = “ 尾数顺位 9 位 ”
Cells(n + START_ROW, 2) = “99”
GoTo break
End If
‘ 尾数顺位 8 位
regx.Pattern = “(?:0(?=1)|1(?=2)|2(?=3)|3(?=4)|4(?=5)|5(?=6)|6(?=7)|7(?=8)|8(?=9)){7}\d”
If regx.Test(Right(rn.Value, 8)) Then
Cells(n + START_ROW, 4) = “ 尾数顺位 8 位 ”
Cells(n + START_ROW, 2) = “99”
GoTo break
End If
‘ 尾数顺位 7 位
regx.Pattern = “(?:0(?=1)|1(?=2)|2(?=3)|3(?=4)|4(?=5)|5(?=6)|6(?=7)|7(?=8)|8(?=9)){6}\d”
If regx.Test(Right(rn.Value, 7)) Then
Cells(n + START_ROW, 4) = “ 尾数顺位 7 位 ”
Cells(n + START_ROW, 2) = “99”
GoTo break
End If
‘ 尾数连号 9 位
regx.Pattern = “([\d])\1{8,}”
If regx.Test(Right(rn.Value, 9)) Then
Cells(n + START_ROW, 4) = “ 尾数连号 9 位 ”
Cells(n + START_ROW, 2) = “99”
GoTo break
End If
‘ 尾数连号 8 位
regx.Pattern = “([\d])\1{7,}”
If regx.Test(Right(rn.Value, 8)) Then
Cells(n + START_ROW, 4) = “ 尾数连号 8 位 ”
Cells(n + START_ROW, 2) = “99”
GoTo break
End If
‘ 尾数连号 7 位
regx.Pattern = “([\d])\1{6,}”
If regx.Test(Right(rn.Value, 7)) Then
Cells(n + START_ROW, 4) = “ 尾数连号 7 位 ”
Cells(n + START_ROW, 2) = “99”
GoTo break
End If
‘ 尾数连号 6 位 尾号 6、8、9
regx.Pattern = “([6|8|9])\1{5}”
If regx.Test(Right(rn.Value, 6)) Then
Cells(n + START_ROW, 4) = “ 尾数连号 6 位 尾号 6、8、9”
Cells(n + START_ROW, 2) = “89”
GoTo break
End If
‘ 尾数连号 6 位 尾号非 6、8、9
regx.Pattern = “([\d])\1{5,}”
If regx.Test(Right(rn.Value, 6)) Then
Cells(n + START_ROW, 4) = “ 尾数连号 6 位 尾号非 6、8、9”
Cells(n + START_ROW, 2) = “79”
GoTo break
End If
‘ 尾数顺位 6 位
regx.Pattern = “(?:0(?=1)|1(?=2)|2(?=3)|3(?=4)|4(?=5)|5(?=6)|6(?=7)|7(?=8)|8(?=9)){5}\d”
If regx.Test(Right(rn.Value, 6)) Then
Cells(n + START_ROW, 4) = “ 尾数顺位 6 位 ”
Cells(n + START_ROW, 2) = “79”
GoTo break
End If
‘ 尾数连号 5 位 尾号 6、8、9
regx.Pattern = “([6|8|9])\1{4}”
If regx.Test(Right(rn.Value, 5)) Then
Cells(n + START_ROW, 4) = “ 尾数连号 5 位 尾号 6、8、9”
Cells(n + START_ROW, 2) = “69”
GoTo break
End If
‘ 尾数连号 6 位 尾号非 6、8、9
regx.Pattern = “([\d])\1{4,}”
If regx.Test(Right(rn.Value, 5)) Then
Cells(n + START_ROW, 4) = “ 尾数连号 5 位 尾号非 6、8、9”
Cells(n + START_ROW, 2) = “59”
GoTo break
End If
‘ 尾数顺位 5 位
regx.Pattern = “(?:0(?=1)|1(?=2)|2(?=3)|3(?=4)|4(?=5)|5(?=6)|6(?=7)|7(?=8)|8(?=9)){4}\d”
If regx.Test(Right(rn.Value, 5)) Then
Cells(n + START_ROW, 4) = “ 尾数顺位 5 位 ”
Cells(n + START_ROW, 2) = “59”
GoTo break
End If
‘ 尾数连号 4 位 尾号 6、8、9
regx.Pattern = “([6|8|9])\1{3}”
If regx.Test(Right(rn.Value, 4)) Then
Cells(n + START_ROW, 4) = “ 尾数连号 4 位 尾号 6、8、9”
Cells(n + START_ROW, 2) = “49”
GoTo break
End If
‘ 尾数连号 4 位 尾号非 6、8、9
regx.Pattern = “([\d])\1{3,}”
If regx.Test(Right(rn.Value, 4)) Then
Cells(n + START_ROW, 4) = “ 尾数连号 4 位 尾号非 6、8、9”
Cells(n + START_ROW, 2) = “39”
GoTo break
End If
‘ 尾数顺位 4 位
regx.Pattern = “(?:0(?=1)|1(?=2)|2(?=3)|3(?=4)|4(?=5)|5(?=6)|6(?=7)|7(?=8)|8(?=9)){3}\d”
If regx.Test(Right(rn.Value, 4)) Then
Cells(n + START_ROW, 4) = “ 尾数顺位 4 位 ”
Cells(n + START_ROW, 2) = “39”
GoTo break
End If
‘ 尾数连号 3 位 尾号 6、8、9
regx.Pattern = “([6|8|9])\1{2}”
If regx.Test(Right(rn.Value, 3)) Then
Cells(n + START_ROW, 4) = “ 尾数连号 3 位 尾号 6、8、9”
Cells(n + START_ROW, 2) = “29”
GoTo break
End If
‘ 尾数连号 3 位 尾号非 6、8、9
regx.Pattern = “([\d])\1{2,}”
If regx.Test(Right(rn.Value, 3)) Then
Cells(n + START_ROW, 4) = “ 尾数连号 3 位 尾号非 6、8、9”
Cells(n + START_ROW, 2) = “19”
GoTo break
End If
‘AABBCCDD AABBAABB
regx.Pattern = “(.)\1{1}(.)\2{1}(.)\3{1}(.)\4{1}”
If regx.Test(Right(rn.Value, 8)) Then
Cells(n + START_ROW, 4) = “AABBCCDD AABBAABB”
Cells(n + START_ROW, 2) = “7”
GoTo break
End If
‘ 中段 5 连号以上，且号码无 4
regx.Pattern = “[0-35-9]+([0-35-9])\1{4}[0-35-9]*”
If regx.Test(rn.Value) Then
Cells(n + START_ROW, 4) = “ 中段 5 连号以上，且号码无 4 ”
Cells(n + START_ROW, 2) = “7”
GoTo break
End If
‘ 未 4 位和前 4 位一样
regx.Pattern = “([\d]{4})\1”
If regx.Test(Right(rn.Value, 8)) Then
Cells(n + START_ROW, 4) = “ 未 4 位和前 4 位一样 ”
Cells(n + START_ROW, 2) = “6”
GoTo break
End If
‘ 尾号 AABBCC C!=4
regx.Pattern = “([\d])\1{1}([\d])\2{1}([0-35-9])\3{1}”
If regx.Test(Right(rn.Value, 6)) Then
Cells(n + START_ROW, 4) = “ 尾号 AABBCC C!=4”
Cells(n + START_ROW, 2) = “6”
GoTo break
End If
‘ 尾数 4 位顺降 DCBA A!=4
regx.Pattern = “(?:9(?=8)|8(?=7)|7(?=6)|6(?=5)|5(?=4)|4(?=3)|3(?=2)|2(?=1)|1(?=0)){3}\d”
If Right(rn.Value, 1) <> 4 Then
If regx.Test(Right(rn.Value, 4)) Then
Cells(n + START_ROW, 4) = “ 尾数 4 位顺降 DCBA A!=4”
Cells(n + START_ROW, 2) = “6”
GoTo break
End If
End If
‘==============================================================
‘ 尾数 ABAB A 或 B 等于 4
regx.Pattern = “4”
If regx.Test(Right(rn.Value, 4)) Then
regx.Pattern = “(\d{2})\1”
If regx.Test(Right(rn.Value, 4)) Then
Cells(n + START_ROW, 4) = “ 尾数 ABAB A 或 B 等于 4 ”
Cells(n + START_ROW, 2) = level(8)
GoTo break
End If
End If
‘ 尾数 AABB A 或 B 等于 4
regx.Pattern = “4”
If regx.Test(Right(rn.Value, 4)) Then
regx.Pattern = “(\d)\1{1}(\d)\2{1}”
If regx.Test(Right(rn.Value, 4)) Then
Cells(n + START_ROW, 4) = “ 尾数 AABB A 或 B 等于 4 ”
Cells(n + START_ROW, 2) = level(8)
GoTo break
End If
End If
‘ 尾数 AAAAB A 或 B 等于 4
regx.Pattern = “4”
If regx.Test(Right(rn.Value, 5)) Then
regx.Pattern = “(\d)\1{3}\d+”
If regx.Test(Right(rn.Value, 5)) Then
Cells(n + START_ROW, 4) = “ 尾数 AAAAB A 或 B 等于 4 ”
Cells(n + START_ROW, 2) = level(8)
GoTo break
End If
End If
‘ 尾数 AAAB A 或 B 等于 4
regx.Pattern = “4”
If regx.Test(Right(rn.Value, 4)) Then
regx.Pattern = “(\d)\1{2}\d+”
If regx.Test(Right(rn.Value, 4)) Then
Cells(n + START_ROW, 4) = “ 尾数 AAAB A 或 B 等于 4 ”
Cells(n + START_ROW, 2) = level(8)
GoTo break
End If
End If
‘==============================================================
‘ 尾数 ABAB A 或 B =6 8 9
regx.Pattern = “6|8|9”
If regx.Test(Right(rn.Value, 4)) Then
regx.Pattern = “(\d{2})\1”
If regx.Test(Right(rn.Value, 4)) Then
Cells(n + START_ROW, 4) = “ 尾数 ABAB A 或 B =6 8 9”
Cells(n + START_ROW, 2) = level(10)
GoTo break
End If
End If
‘ 尾数 AABB A 或 B =6 8 9
regx.Pattern = “6|8|9”
If regx.Test(Right(rn.Value, 4)) Then
regx.Pattern = “(\d)\1{1}(\d)\2{1}”
If regx.Test(Right(rn.Value, 4)) Then
Cells(n + START_ROW, 4) = “ 尾数 AABB A 或 B =6 8 9”
Cells(n + START_ROW, 2) = level(10)
GoTo break
End If
End If
‘ 尾数 AAAAB A 或 B =6 8 9
regx.Pattern = “6|8|9”
If regx.Test(Right(rn.Value, 5)) Then
regx.Pattern = “(\d)\1{3}\d+”
If regx.Test(Right(rn.Value, 5)) Then
Cells(n + START_ROW, 4) = “ 尾数 AAAAB A 或 B =6 8 9”
Cells(n + START_ROW, 2) = level(10)
GoTo break
End If
End If
‘ 尾数 AAAB A 或 B =6 8 9
regx.Pattern = “6|8|9”
If regx.Test(Right(rn.Value, 4)) Then
regx.Pattern = “(\d)\1{2}\d+”
If regx.Test(Right(rn.Value, 4)) Then
Cells(n + START_ROW, 4) = “ 尾数 AAAB A 或 B =6 8 9”
Cells(n + START_ROW, 2) = level(0)
GoTo break
End If
End If
‘============================================================
‘ 尾数 ABAB A 或 B 不等于 4 6 8 9
regx.Pattern = “\d”
If regx.Test(Right(rn.Value, 4)) Then
regx.Pattern = “(\d{2})\1”
If regx.Test(Right(rn.Value, 4)) Then
Cells(n + START_ROW, 4) = “ 尾数 ABAB A 或 B 不等于 4 6 8 9 ”
Cells(n + START_ROW, 2) = level(9)
GoTo break
End If
End If
‘ 尾数 AABB A 或 B 不等于 4 6 8 9
regx.Pattern = “\d”
If regx.Test(Right(rn.Value, 4)) Then
regx.Pattern = “(\d)\1{1}(\d)\2{1}”
If regx.Test(Right(rn.Value, 4)) Then
Cells(n + START_ROW, 4) = “ 尾数 AABB A 或 B 不等于 4 6 8 9 ”
Cells(n + START_ROW, 2) = level(9)
GoTo break
End If
End If
‘ 尾数 AAAAB A 或 B 不等于 4 6 8 9
regx.Pattern = “\d”
If regx.Test(Right(rn.Value, 5)) Then
regx.Pattern = “(\d)\1{3}\d+”
If regx.Test(Right(rn.Value, 5)) Then
Cells(n + START_ROW, 4) = “ 尾数 AAAAB A 或 B 不等于 4 6 8 9 ”
Cells(n + START_ROW, 2) = level(9)
GoTo break
End If
End If
‘ 尾数 AAAB A 或 B 不等于 4 6 8 9
regx.Pattern = “\d”
If regx.Test(Right(rn.Value, 4)) Then
regx.Pattern = “(\d)\1{2}\d+”
If regx.Test(Right(rn.Value, 4)) Then
Cells(n + START_ROW, 4) = “ 尾数 AAAB A 或 B 不等于 4 6 8 9 ”
Cells(n + START_ROW, 2) = level(9)
GoTo break
End If
End If
‘ 尾号 AA A= 4
regx.Pattern = “(4)\1”
If regx.Test(Right(rn.Value, 2)) Then
Cells(n + START_ROW, 4) = “ 尾号 AA A=4”
Cells(n + START_ROW, 2) = level(5)
GoTo break
End If
‘ 尾号 AA A= 6 8 9
regx.Pattern = “([6|8|9])\1”
If regx.Test(Right(rn.Value, 2)) Then
Cells(n + START_ROW, 4) = “ 尾号 AA A= 6 8 9”
Cells(n + START_ROW, 2) = level(7)
GoTo break
End If
‘ 尾号 AA A 不等于 4 6 8 9
regx.Pattern = “(\d)\1”
If regx.Test(Right(rn.Value, 2)) Then
Cells(n + START_ROW, 4) = “ 尾号 AA A 不等于 4 6 8 9”
Cells(n + START_ROW, 2) = level(6)
GoTo break
End If
‘ 尾数 3 位正顺号 ABC C 不等于 4
regx.Pattern = “(?:0(?=1)|1(?=2)|2(?=3)|3(?=4)|4(?=5)|5(?=6)|6(?=7)|7(?=8)|8(?=9)){2}\d”
If Right(rn.Value, 1) <> 4 Then
If regx.Test(Right(rn.Value, 3)) Then
Cells(n + START_ROW, 4) = “ 尾数 3 位正顺号 ABC C 不等于 4 ”
Cells(n + START_ROW, 2) = level(4)
GoTo break
End If
End If
‘ 尾号末两位 18 58 68 98
regx.Pattern = “18|58|68|98”
If regx.Test(Right(rn.Value, 2)) Then
Cells(n + START_ROW, 4) = “ 尾号末两位 18 58 68 98”
Cells(n + START_ROW, 2) = level(3)
GoTo break
End If
‘ 尾号一个 8
regx.Pattern = “8”
If regx.Test(Right(rn.Value, 1)) Then
Cells(n + START_ROW, 4) = “ 尾号一个 8 ”
Cells(n + START_ROW, 2) = level(2)
GoTo break
End If
‘ 后四位带 4
regx.Pattern = “4”
If regx.Test(Right(rn.Value, 4)) Then
Cells(n + START_ROW, 4) = “ 后四位带 4 ”
Cells(n + START_ROW, 2) = “100 分 ”
Cells(n + START_ROW, 2) = level(0)
GoTo break
End If
‘ 后四位不带 4
regx.Pattern = “[0-35-9]”
If regx.Test(Right(rn.Value, 4)) Then
Cells(n + START_ROW, 4) = “ 后四位不带 4 ”
Cells(n + START_ROW, 2) = level(1)
GoTo break
End If
Else
Cells(n + START_ROW, 4) = “ 手机号格式不正确 ”
Cells(n + START_ROW, 2) = “ 错误！！！”
GoTo break
End If
break:
Next
End Sub