两列数据查找不同之处

Dragonfly7995

麻烦大神指点一下，我需要寻找Ｂ列所有的数据中，把未在Ａ列出现过的找出来，并复制到Ｃ列，但不用理会A列数据中未在B列出现的

saigyouryu

试试这个可以不

Sub a()
    cst = "不一致"
    With Sheets(1)
        Set arng = .Range("a2", .[a65536].End(xlUp))
        For Each ave In .Range("b2", .[b65536].End(xlUp))
            Set fve = arng.Find(ave)
            If fve Is Nothing Then
                cst = cst & "," & ave
            End If
        Next
        arrbuyizhi = Split(cst, ",")
        [c1].Resize(UBound(arrbuyizhi) + 1, 1) = Application.Transpose(arrbuyizhi)
    End With
End Sub

kimmyyang

一个判断公式自己能搞定吧

lsc900707

1. Sub gj23w98()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     arr = [a1].CurrentRegion
   
4.     ReDim brr(1 To UBound(arr), 1 To 1)
   
5.     For i = 2 To UBound(arr)
   
6.         s = Trim(arr(i, 1))
   
7.         d(s) = ""
   
8.     Next
   
9.     For i = 2 To UBound(arr)
   
10.         s = Trim(arr(i, 2))
    
11.         If Not d.exists(s) Then
    
12.             m = m + 1
    
13.             d(s) = m
    
14.             brr(m, 1) = arr(i, 2)
    
15.         End If
    
16.     Next
    
17.     If m Then [c2].Resize(m, 1) = brr
    
18. End Sub

复制代码

lsc900707

参考测试附件：

Dragonfly7995

lsc900707 发表于 2019-5-10 11:24
参考测试附件：

谢谢大神指点，我先看看，不明白的地方再请教

EH2003

Dragonfly7995 发表于 2019-5-10 14:48
谢谢大神指点，我先看看，不明白的地方再请教

EH2003

Sub gj23w98()
     Dim d As Object
    Dim i As Long, n1 As Long, n2 As Long, n3 As Long, m As Long
    Dim strTemp As String
    Dim arr1 As Variant, arr2 As Variant, brr As Variant, kr As Variant
    Dim rng1 As Range, rng2 As Range, rng As Range
    Set d = CreateObject("scripting.dictionary")
    On Error Resume Next
    Set rng1 = Application.InputBox("请选择需要核对差异的第一列数据", Type:=8)
    '用户选取第一列数据
    If rng1.Columns.Count > 1 Then MsgBox "请选择单列数据。": Exit Sub
    If rng1.Rows.Count = 1 Then MsgBox "不能选择单个单元格。": Exit Sub
    Set rng1 = Intersect(rng1.Parent.UsedRange, rng1)
    '防止用户选取整列造成运算量虚大效率低下
    If Not rng1 Is Nothing Then arr1 = rng1.Value
    '将第一列数据装入arr1
    Set rng2 = Application.InputBox("请选择需要核对差异的第二列数据", Type:=8)
    '用户选取第二列数据
    If rng2.Columns.Count > 1 Then MsgBox "请选择单列数据。": Exit Sub
    If rng2.Rows.Count = 1 Then MsgBox "不能选择单个单元格。": Exit Sub
    Set rng2 = Intersect(rng2.Parent.UsedRange, rng2)
    If Not rng2 Is Nothing Then arr2 = rng2.Value
    For i = 2 To UBound(arr1) '扣除标题行
        If Len(arr1(i, 1)) Then
            d("'" & arr1(i, 1)) = "不存在"
            '将数据统一强制转换为字符串格式
            '数据装入字典，先统一设置item为不存在
        End If
    Next
    If UBound(arr1) > UBound(arr2) Then
    '计算两列最大行数
        m = UBound(arr1)
    Else
        m = UBound(arr2)
    End If
    ReDim brr(0 To m, 1 To 3)
    '结果数组
    '第一列放AB均存在的数据
    '第二列放A有B没有的数据
    '第三列放B有A没有的数据
    For i = 2 To UBound(arr2)
        If Len(arr2(i, 1)) Then
            strTemp = "'" & arr2(i, 1)
            If d.exists(strTemp) Then '如果A有B也有
                n1 = n1 + 1
                brr(n1, 1) = strTemp
                d(strTemp) = "存在"
                '将AB均有的数据item修改为存在
            Else '如果B有A没有
                n3 = n3 + 1
                brr(n3, 3) = strTemp
            End If
        End If
    Next
    kr = d.keys
    For i = 0 To UBound(kr)
        If d(kr(i)) = "不存在" Then '如果A有B没有
            n2 = n2 + 1
            brr(n2, 2) = kr(i)
        End If
    Next
    Err.Clear
    Set rng = Application.InputBox("请选择放置查询结果的单元格，例如C1", Type:=8)
    rng.Parent.Select
    rng.Select
    If Err.Number = 0 Then
        brr(0, 1) = "两列均存在的数据有" & n1 & "条"
        brr(0, 2) = "A有B没有的数据有" & n2 & "条"
        brr(0, 3) = "B有A没有的数据有" & n3 & "条"
        With rng(1).Resize(UBound(brr) + 1, 3)
            .ClearContents '打扫房间清除数据
            .NumberFormatLocal = "@"
            '设置文本格式，防止文本数值变形
            .Value = brr
        End With
        MsgBox "核对完成。" & vbLf & brr(0, 1) & vbLf & brr(0, 2) & vbLf & brr(0, 3)
    End If
    Set d = Nothing
    Set rng = Nothing
    Set rng1 = Nothing
    Set rng2 = Nothing
    Erase arr1: Erase arr2: Erase brr
End Sub

EH2003

代码需要审核，现在把文件发上来。已经是通用对比 两列数据查找不同之处.zip (118.57 KB, 下载次数: 93)

2019-5-10 15:24 上传

点击文件名下载附件

Dragonfly7995

lsc900707 发表于 2019-5-10 11:22

请教两个问题，1.m=m+1,未设置m，那么m是不是从0开始。2.If m Then [c2].Resize(m, 1) = brr，这段代码中，为什么if后面m不用任何判断条件，就直接可以接then。谢谢