靓号等级生成器，正则+VBA代码

昨天收到一个需求，根据要求生成每个号码的等级（图片）

下面是最后做出的效果

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