Question

我在两个工作表上比较两列的两个范围。然后将任何重复数据写入第三个工作表。我从这里开始使用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。

提前致谢！...我已经把头缠绕了好几个小时。

Answer 1

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

比较范围和粘贴结果VBA

1 个答案: