只需要简单地检查两列彼此，并把不同的东西

你会认为这个问题已经被回答了，但是我找不到一个这样做的人。 我有两张从A3开始的A列date比较。 如果第二张表的A列缺less一个date，那么我希望它只是从第二张纸的I3开始输出该date。 我觉得这是非常简单的，但我拼凑在一起的代码总是混乱起来。 表1

表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

一些变体数组和字典对象应该快速地分离孤儿date。

 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 

如果您有很多date需要收集，那么应用TRANSPOSEfunction可能会超载，但是必须在成千上万（> 65,536个孤立的date）。