Доброго всем времени суток. Работая с большой базой таблиц, есть необходимость сравнивать множество параметров, написал код чтобы сравнивать значения, но не могу "допетрить" как осуществить добавление недостающих значений. В реальном фале сравниваю много параметров, в приведенном примере ниже, всего по 3 столбца
Код
Sub Сравнить_и_добавить()
Dim i&, j&, x&, y&, LastRow_1&, LastRow_2&
Dim aaa()
Dim bbb()
LastRow_1 = Cells(Rows.Count, 1).End(xlUp).Row
LastRow_2 = Cells(Rows.Count, 6).End(xlUp).Row
ReDim aaa(LastRow_1 - 1, 2)
ReDim bbb(LastRow_2 - 1, 2)
'заполняем массивы данными
For i = 0 To UBound(aaa)
aaa(i, 0) = Cells(i + 1, 1) 'Номер1
aaa(i, 1) = Cells(i + 1, 2) 'Дата1
aaa(i, 2) = Cells(i + 1, 3) 'Условие1
Next
For j = 0 To UBound(bbb)
bbb(j, 0) = Cells(j + 1, 6) 'Номер2
bbb(j, 1) = Cells(j + 1, 7) 'Дата2
bbb(j, 2) = Cells(j + 1, 8) 'Условие2
Next
For y = 0 To UBound(aaa)
For x = 0 To UBound(bbb)
If InStr(bbb(y, 2), "IA") Then
'если номер и дата совпадают
LastRow_1 = Cells(Rows.Count, 1).End(xlUp).Row
If bbb(x, 0) = aaa(y, 0) And bbb(x, 1) = aaa(y, 1) Then
Cells(y + 1, 2).Font.Color = RGB(0, 0, 255)
ElseIf bbb(x, 0) = aaa(y, 0) And bbb(x, 1) <> aaa(y, 1) Then
Cells(y + 1, 2).Value = bbb(x, 1)
Cells(y + 1, 2).Font.Color = RGB(255, 0, 0)
End If
End If
Next
Next
End Sub
Алгоритм сравнивания: 1. Работаем если в столбце 8 есть параметр IA 2. Ищем номер из столбцов 6 в столбце 1 3. Если дата совпадает, то окрашиваем в синий, если нет, то заменяем и в красный
А вот как, если номера в столбце 1 нет! Как добавить в конец столбца?
slesarok, Добрый день, не знаю какая у Вас в дальнейшем будет обработка, если просто добавить значения в первый столбец, то можно так:
Код
Sub Сравнить_и_добавить()
Dim i&, j&, x&, y&, LastRow_1&, LastRow_2&
Dim aaa As Variant
Dim bbb As Variant
LastRow_1 = Cells(Rows.Count, 1).End(xlUp).Row
LastRow_2 = Cells(Rows.Count, 6).End(xlUp).Row
aaa = Range("A1:C" & LastRow_1)
bbb = Range("F1:H" & LastRow_2)
i = 1
For y = 1 To UBound(aaa)
For x = 1 To UBound(bbb)
If InStr(bbb(x, 3), "IA") Then
If bbb(x, 1) = aaa(y, 1) And bbb(x, 2) = aaa(y, 2) Then
Cells(y, 2).Font.Color = RGB(0, 0, 255)
ElseIf bbb(x, 1) = aaa(y, 1) And bbb(x, 2) <> aaa(y, 2) Then
Cells(LastRow_1 + i, 1).Value = bbb(x, 1)
Cells(LastRow_1 + i, 2).Value = bbb(x, 2)
Cells(LastRow_1 + i, 3).Value = bbb(x, 3)
Cells(LastRow_1 + i, 2).Font.Color = RGB(255, 0, 0)
i = i + 1
End If
End If
Next
Next
End Sub
Но тут нужно учесть, что найдя одно совпадение по первому столбцу например 66, а во втором столбце этого совпадения нет то значение будет добавлено в любом случае, даже при условии, что ниже строит уже полностью идентичное совпадение, это видно если нажать дважды на кнопку. В зависимости от Ваших целей и задач нужно вносить изменения в макрос или написать его заново.
msi2102, Спасибо за ответ! Но немного не так, по совпадению мне добавлять не надо, надо наоборот: Если в правом столбце6 (номера) есть значение, а в левом столбце1 - нет, то добавить!