Двойное сравнение?.....

[sonata]

Задача такая:
Есть 2 диапазона с данными
№договора и Сумма договора
необходимо произвести двойное сравнение
1)сравнить наличие одинаковых № договоров
2) если они равны, то сравнить их сумму.
Как найти одинаковые номера я -знаю,
а как потом сравнить их суммы?

Код: Выделить всё

Public Sub Сравнение_договоров()
Set workSheet1 = Worksheets("1")      'лист который будем красить
Set workSheet2 = Worksheets("1")      'лист на котором ищем совпадения
Set range1 = workSheet1.Range("A5:A5000")  'диапазон, который обрабатываем
Set range2 = workSheet2.Range("D5:D5000") 'диапазон, с которым сравниваем

Dim curField As Object
Dim findedField As Object

For Each curField In range1
    Set findedField = range2.Find(What:=curField.Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
    If Not findedField Is Nothing Then
        curField.Font.Color = vbRed
        findedField.Font.Color = vbRed
    End If
Next curField

End Sub

[GSerg]

Код: Выделить всё

Sub Сравнение_Договоров(DNumbersAndValues1 As Excel.Range, DNumbersAndValues2 As Excel.Range, Optional ByVal TreatiesMatchSummNotColorIndex As Long = 3, Optional ByVal TreatiesAndSummMatchColorIndex As Long = 6)
  'DNumbersAndValues1 - диапазон из двух столбиков: Номер и Стоимость. Тут красим
  'DNumbersAndValues2 - тот же самое. Тут ищем.
  'TreatiesMatchSummNotColorIndex - цвет, которым пометим совпадающие договора, у которых не совпадают суммы
  'TreatiesAndSummMatchColorIndex - цвет, которым пометим совпадающие договора, у которых совпадают суммы
 
  Dim c As Excel.Range
 
  On Error GoTo errh
  For Each c In DNumbersAndValues1.Columns(1).Rows
    If DNumbersAndValues2.Columns(1).Find(c.Value, , xlValues, xlWhole).Offset(0, 1).Value = c.Offset(0, 1).Value Then c.Interior.ColorIndex = TreatiesAndSummMatchColorIndex Else c.Interior.ColorIndex = TreatiesMatchSummNotColorIndex
continue:
  Next
  Exit Sub
errh:
  Resume continue
End Sub

Sub sfghdjdfhj()
  Сравнение_Договоров Range("a1:b10"), Range("d6:e15")
End Sub