当先锋百科网

首页 1 2 3 4 5 6 7

昨天收到一个需求,根据要求生成每个号码的等级(图片)

下面是最后做出的效果

下面是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

下面是子表二的行列信息

号码属性 号码段 起始号码 结束号码 数量 地市 区域/县份

铁通固话 1470780 14707806000 14707806099 100 772 融安县铁通固话

铁通固话 1470780 14707806100 14707806199 100 772 融安县铁通固话

![clipboard.png](/img/bVbx9j4)