Страницы: 1
RSS
Добавить недостающие позиции при сравнении массива столбцов
 
Доброго всем времени суток.
Работая с большой базой таблиц, есть необходимость сравнивать множество параметров, написал код чтобы сравнивать значения, но не могу "допетрить" как осуществить добавление недостающих значений.
В реальном фале сравниваю много параметров, в приведенном примере ниже, всего по 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 - 29.06.2020 12:32:10
 
slesarok, здравствуйте, Вы бы приложили файл с примером (см. ПРАВИЛА форума, п.2.3), может дела быстрее пойдут.
 
Пытался загрузить, в любых форматах виснет загрузка на 90% и все (
Добавил файл. Посмотрите, пожалуйста
 
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 - нет, то добавить!

На примере сравнивания 2 столбцов:
Было
21
32
43
4
5
После сравнения стало
21
32
43
14
55
Изменено: slesarok - 30.06.2020 14:57:41
 
Вы покажите в файле как это должно быть
 
В файле пометил, как должно быть.
Спасибо!
 
Так?
 
Отлично! Я хотел понять этот алгоритм. Сейчас применю на своей оригинальном фалйе!
Спасибо!
Страницы: 1
Наверх