Сравнить, нельзя помиловать

[madmaniac]

нужно сравнить 2 столбца с текстовыми данными в exel.
и при найденых совпадениях выдилять их в цвет.
есть код но он чет заматерился при проверке 6х9
помогите плз.
зарание спасибо

Dim fname As String, curname As String
Dim numrow As Integer, numcol As Integer, i As Integer, j As Integer
Dim message1 As String
Dim addr As Variant
Dim cell As Variant
Dim var1(1 To 6, 1 To 9) As Variant
Dim var2(1 To 6, 1 To 9) As Variant
Dim flag(1 To 10) As Boolean
For i = 1 To 9
    flag(i) = False
Next i
fname = "книга.xls"  ' здесь название файла, откуда будут сравниваться ячейки в строках
curname = Windows(1).Caption
With Application.FileSearch
    .LookIn = ActiveWorkbook.path
    .Filename = fname  
    .SearchSubFolders = False
    If .Execute = 0 Then
        MsgBox "Не обнаружен файл"
        End
    Else
        fname = .FoundFiles(1)
    End If
End With
Workbooks.Open Filename:=fname
Range("A1").Select
For j = 1 To 9  'строки'
    For i = 1 To 6 'cтолбци'
        var1(i, j) = ActiveCell.FormulaR1C1
        ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
    Next i
    Range("A1").Select
    ActiveCell.Offset(rowOffset:=j, columnOffset:=0).Activate
Next j
Windows(curname).Activate
Range("A1").Select   'начиная с ячейки а1'
For j = 1 To 9	'строка'
    For i = 1 To 6 'столбец'
        If var1(i, j) = ActiveCell.FormulaR1C1 Then
            flag(j) = True
            Exit For
        End If
        ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
    Next i
    Range("A1").Select
    ActiveCell.Offset(rowOffset:=j, columnOffset:=0).Activate
Next j
Range("A1:F1").Select
For j = 1 To 9	'строка'
    If flag(j) = True Then
        Selection.Offset(j - 1, 0).Activate
        For Each cell In Application.Selection
            addr = cell.Address()
            Range(addr).Interior.ColorIndex = 6
        Next cell
    End If
    Range("A1:F1").Select
Next j

[NoLL]

Глянь сдесь.

http://programmersforum.ru/showthrea...highlight=NoLL

[madmaniac]

пасиб ))))