VBA how to achieve a string ID after dismantling the breakdown, to find out if in addition one?

A data source

 

Needs analysis

How to achieve a string of dismantling after the breakdown, to find out whether another column in?

demand analysis

• Do not check the weight
• No blank check
• But the need to leak, did not check the corresponding
   

 

Code 3

Sub ID自动查漏()
Dim target_area1 As Object
Dim dict1 As Object
Set dict1 = CreateObject("scripting.dictionary")


MsgBox "开始前，请确保您要查错的列位于A列，要引用的列位于C列，并空出B列"
target1 = Application.InputBox("请输入您用于分隔的符号，只能1个,注意全角半角", "输入1个分隔符")

Range("b:b").ClearContents
Range("b1") = "报警列"


cr1 = Application.CountA(Range("A:A"))
minr1 = Range("A1").End(xlUp).Row
maxr1 = Range("A65536").End(xlUp).Row

Debug.Print cr, minr, maxr

For i = minr1 To maxr1
   dict1(i) = Split(Cells(i, 1), target1)
Next



cr2 = Application.CountA(Range("c:c"))
minr2 = Range("c1").End(xlUp).Row
maxr2 = Range("c65536").End(xlUp).Row
'arr1 = Application.Transpose(Range("c1:c20"))
arr1 = Application.Transpose(Range("c" & minr2 & ":" & "c" & maxr2))



arr20 = dict1.keys()
arr21 = dict1.items()



For j = LBound(arr21) To UBound(arr21)
    For Each k In arr21(j)
        Debug.Print k;
        If IsNumeric(k) Then
             Debug.Print Application.Match(Int(k), arr1, 0);
             If IsError(Application.Match(Int(k), arr1, 0)) Then
                Cells(j + 1, 2).Value = "有ID查不到"
             End If
        End If
    Next
    Debug.Print
Next

End Sub

 

 

 

4 Code refreshing version

Sub ID自动查漏()


Dim target_area1 As Object
Dim dict1 As Object
Set dict1 = CreateObject("scripting.dictionary")


MsgBox "开始前，请确保您要查错的列位于A列，要引用的列位于C列，并空出B列"
target1 = Application.InputBox("请输入您用于分隔的符号，只能1个,注意全角半角", "输入1个分隔符")

Range("b:b").ClearContents
Range("b1") = "报警列"


cr1 = Application.CountA(Range("A:A"))
minr1 = Range("A1").End(xlUp).Row
maxr1 = Range("A65536").End(xlUp).Row
cr2 = Application.CountA(Range("c:c"))
minr2 = Range("c1").End(xlUp).Row
maxr2 = Range("c65536").End(xlUp).Row
arr1 = Application.Transpose(Range("c" & minr2 & ":" & "c" & maxr2))


For i = minr1 To maxr1
   dict1(i) = Split(Cells(i, 1), target1)
Next

arr20 = dict1.keys()
arr21 = dict1.items()
For j = LBound(arr21) To UBound(arr21)
    For Each k In arr21(j)
        If IsNumeric(k) Then
             If IsError(Application.Match(Int(k), arr1, 0)) Then
                Cells(j + 1, 2).Value = "有ID查不到"
             End If
        End If
    Next
    Debug.Print
Next

End Sub

 

5 Output Output column for details see