请教姓名及手机号数据不在一张表上怎么核对？

一念成佛

如题

姓名手机号核对，不一致的字符进行标红加粗，现在做的VBA代码数据都在一张表上，现需要把正确的姓名手机号作为基本信息放到另一张表上，不影响本表删除行列的操作，请问怎么改进一下代码，请各位老师不吝赐教，谢谢！

Sub 核对负责人及手机号()
Dim arr, x, c, i
arr = Sheet1.Range("u6").CurrentRegion.Value
With Sheet1.Range("n5")
    For j = 1 To UBound(arr, 2)
    For i = 1 To UBound(arr)
        x = InStr(.Value, arr(i, j))
        If x Then
        c = Len(arr(i, j))
        With Sheet1.Range("n5").Characters(Start:=x, Length:=c).Font
        .Color = -16776961
        .Bold = True
        End With
       End If
    Next i
Next
End With
'MsgBox "核对完成！"
End Sub 比对1.zip (19.78 KB, 下载次数: 5)

2024-10-13 13:37 上传

点击文件名下载附件

一念成佛

Sub 核对负责人及手机号()
Dim arr, x, c, i
arr = Sheet1.Range("u6").CurrentRegion.Value
With Sheet1.Range("n5")
    For j = 1 To UBound(arr, 2)
    For i = 1 To UBound(arr)
        x = InStr(.Value, arr(i, j))
        If x Then
        c = Len(arr(i, j))
        With Sheet1.Range("n5").Characters(Start:=x, Length:=c).Font
        .Color = -16776961
        .Bold = True
        End With
       End If
    Next i
Next
End With
'MsgBox "核对完成！"
End Sub

gwjkkkkk

Option Explicit
Sub TEST()
    Dim ar, i&, Matches As Object, aMatch, Rng As Range, strPat$

    Application.ScreenUpdating = False
   
    ar = [U6].CurrentRegion.Value
    For i = 2 To UBound(ar)
        strPat = strPat & "|" & ar(i, 1) & ar(i, 2)
    Next i
   
    Set Rng = [A3].CurrentRegion
    With Rng
        ar = Rng.Value
        .Font.Color = 0
    End With
    With CreateObject("Vbscript.RegExp")
       .Global = True
       .Pattern = Mid(strPat, 2)
        For i = 2 To UBound(ar)
            Set Matches = .Execute(ar(i, 14))
            With Rng
                For Each aMatch In Matches
                   .Cells(i, 14).Characters(aMatch.firstindex + 1, Len(aMatch.Value)).Font.Color = vbRed
                Next
            End With
        Next i
    End With
   
    Set Matches = Nothing: Set Rng = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

参与一下。。。

一念成佛

gwjkkkkk 发表于 2024-10-13 14:32
参与一下。。。

谢谢，辛苦了老师，还给多加了一个单元格的核对。不过，不能对姓名和手机分别核对，分别标红加粗。
另外，如果姓名和手机号之间有空格，标点符号，或回车，就不能比对，这样还能再改进一下吗？

一念成佛

gwjkkkkk 发表于 2024-10-13 14:32
参与一下。。。

老师太谦虚了，不是参与一下，是指导一下。
老师，可不可以把姓名和手机分开核对。姓名与手机号之间有逗号、空格回车等字符，就不能分辨对错，能否再改进一下。谢谢。

一念成佛

gwjkkkkk 发表于 2024-10-13 14:32
参与一下。。。

我真的沙白沙白的，搞不懂代码含义，一直学不会，但一直需要VBA或者函数来减轻工作量。

gwjkkkkk

一念成佛 发表于 2024-10-13 16:09
我真的沙白沙白的，搞不懂代码含义，一直学不会，但一直需要VBA或者函数来减轻工作量。

不知道这样对不对，请参考。。。

一念成佛

gwjkkkkk 发表于 2024-10-13 16:15
不知道这样对不对，请参考。。。

谢谢这次好了，很满意。非常感谢。本论坛又一次帮我一个大忙。