比较范围和粘贴结果VBA



我正在比较两个工作表上两列的两个范围。然后,任何重复的数据都会写入第三个工作表。我从这里开始使用vba:http://support.microsoft.com/kb/213367.

Sub Find_Matches()
Dim CompareRange As Variant, x As Variant, y As Variant, CompareRange2 As Variant
Dim MATCH As Range,
Set MATCH = 'this needs to be dynamic and related to x coordinates
Set CompareRange = Workbooks("Test VBA.xlsx").Worksheets("Sheet1").Range("A1:A10000")
Set CompareRange2 = Workbooks("Test VBA.xlsx").Worksheets("Sheet2").Range("A1:A10000")
For Each x In CompareRange
If Not IsEmpty(x) Then
For Each y In CompareRange2
If Not IsEmpty(y) Then
If x = y Then MATCH = x 'MATCH currently ends on last x=y value when range assigned
End If
Next y
End If
Next x
End Sub

我试着去掉尽可能多的绒毛。第三个空白工作表上的位置应写入列的下一个单元格。在这个例子中,我需要帮助确定x的位置,其中x=y。

提前感谢!。。。我已经想了好几个小时了。

10分钟后我得到了

Sub Find_Matches()
Dim CompareRange As Variant, x As Variant, y As Variant, CompareRange2 As Variant
Dim MATCH As Range,
Dim i As Integer
i = 2 'started at 2 to avoid writing over header in A1
Set CompareRange = Workbooks("Test VBA.xlsx").Worksheets("Sheet1").Range("A1:A10000")
Set CompareRange2 = Workbooks("Test VBA.xlsx").Worksheets("Sheet2").Range("A1:A10000")
For Each x In CompareRange
If Not IsEmpty(x) Then
For Each y In CompareRange2
If Not IsEmpty(y) Then
If x = y Then
Set MATCH = Worksheets(3).Range("A" & i) 'must be set whenever i changes
MATCH = x 'variable is now dynamic
i = 1 + i 'uses next column rather than same coordinates as x
End If
End If
Next y
End If
Next x
End Sub

最新更新