vba - 需要简单地检查两列并输出不同之处

Question

你会认为这个问题以前已经回答过，但我找不到 1 必须这样做的人。我只有从 A3 开始的 A 列上的日期比较两张表。如果第二张纸的 A 列缺少日期，那么我希望它只输出从第二张纸的 I3 开始的日期。我觉得它 super 简单，但我拼凑的代码总是一团糟。 SHEET 1

SHEET 2

如果有人想要代码，我很乐意上传它，但我认为它根本不正确。

Sub jim()
Dim CompareRange As Variant, To_Be_Compared As Variant, x As Variant, y As Variant

Range("A").Select
Selection.End(xlDown).Select
Set To_Be_Compared = Range("ALPHA!A3:" & Selection.Address)
Range("B").Select
Selection.End(xlDown).Select
Set CompareRange = Range("OUTPUT!A3:" & Selection.Address)



i = 1
To_Be_Compared.Select

For Each x In Selection
    For Each y In CompareRange
        If x = y Then
          Range("I3" & i).Value = x
          i = i + 1
        End If
    Next y
Next x
End Sub

Answer 1

一些变体数组和dictionary objects应该快速隔离孤立的日期。

Sub bert()
    Dim v As Long, vALPHAs As Variant, vOUTs As Variant, dTMPs As Object, dOUTs As Object

    Set dOUTs = CreateObject("Scripting.Dictionary")
    Set dTMPs = CreateObject("Scripting.Dictionary")
    dOUTs.CompareMode = vbTextCompare
    dTMPs.CompareMode = vbTextCompare

    With Worksheets("alpha")
        vALPHAs = .Range(.Cells(3, 1), .Cells(Rows.Count, 1).End(xlUp).Offset(0, 1)).Value
    End With

    With Worksheets("output")
        vOUTs = .Range(.Cells(3, 1), .Cells(Rows.Count, 1).End(xlUp)).Value

        For v = LBound(vOUTs, 1) To UBound(vOUTs, 1)
            If Not dOUTs.Exists(vOUTs(v, 1)) Then _
                dOUTs.Add Key:=vOUTs(v, 1), Item:=vOUTs(v, 1)
        Next v

        For v = LBound(vALPHAs, 1) To UBound(vALPHAs, 1)
            If Not dOUTs.Exists(vALPHAs(v, 1)) Then _
                dTMPs.Add Key:=vALPHAs(v, 1), Item:=vALPHAs(v, 2)
        Next v
        If CBool(dTMPs.Count) Then
            v = .Cells(Rows.Count, 9).End(xlUp).Offset(1, 0).Row
            .Cells(v, 9).Resize(dTMPs.Count, 1) = Application.Transpose(dTMPs.keys)
            'optionally bring across the names from column B
            '.Cells(v, 10).Resize(dTMPs.Count, 1) = Application.Transpose(dTMPs.items)
        End If
    End With

    dOUTs.RemoveAll: Set dOUTs = Nothing
    dTMPs.RemoveAll: Set dTMPs = Nothing

End Sub

如果您有很多日期要收集，应用程序 TRANSPOSE function可能会重载，但这必须是数万个(> 65,536 个孤立日期)。