2013-08-07 2 views
0

Я сравниваю два диапазона из двух столбцов на двух листах. Любые повторяющиеся данные затем записываются на третий рабочий лист. Я начал с vba отсюда: http://support.microsoft.com/kb/213367.Сравнение диапазонов и результатов склейки VBA

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 в этом примере.

Заранее спасибо! ... Я часами обволакиваю голову.

+0

Пожалуйста, отступы код. Это невозможно прочитать, когда все выровнено по левому краю. – Tomalak

ответ

0

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 
Смежные вопросы