powered by simpleCommunicator - 2.0.52     © 2025 Programmizd 02
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Выделение не совпадающих строк в листах Excel
23 сообщений из 23, страница 1 из 1
Выделение не совпадающих строк в листах Excel
    #38762392
Vasek11
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Добрый вечер! Есть книга Excel в нем 2 листа с одинаковым кол-во столбцов и различным кол-вом строк. Нужно из 1 листа по первым 4 столбцам сравнить значения с первыми 4 столбцами 2 листа.

Если все значения совпадают то окрасить зеленым цветом строку, иначе закрасить строку красным цветом. Покопался по просторам интернета нашел различные примеры, у меня только получилось найти совпадающие значения и окрасить их в зеленый цвет.

Не могу понять как правильно в цикле пройтись по всем ячейкам в строке и отметить их красным цветом при не совпадении. Вот код который у меня сейчас есть.

Заранее спасибо!

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
Sub test11()
Dim Lr1&, Lr2&
Dim i&, j&
Dim Sh1 As Worksheet, Sh2 As Worksheet
Set Sh1 = Workbooks("Kniga.xlsm").Sheets("Лист1")
Set Sh2 = Workbooks("Kniga.xlsm").Sheets("Лист2")
    Application.ScreenUpdating = False
    Lr1 = Sh1.Range("A1").CurrentRegion.Rows.Count
    Lr2 = Sh2.Range("A1").CurrentRegion.Rows.Count
    With Sh1
        For i = 2 To Lr1
            For j = 2 To Lr2
                If Len(.Cells(i, "A")) Then
                    If .Cells(i, "A") = Sh2.Cells(j, "A") Then
                        If .Cells(i, "B") = Sh2.Cells(j, "B") Then
                            If .Cells(i, "C") = Sh2.Cells(j, "C") Then
                                If .Cells(i, "D") = Sh2.Cells(j, "D") Then
                                        Sh2.Rows(j).Interior.ColorIndex = 4
                                End If
                            End If
                        End If
                    End If
                Else: Exit Sub
                End If
            Next j
        Next i
    End With
    Application.ScreenUpdating = True
End Sub
...
Рейтинг: 0 / 0
Выделение не совпадающих строк в листах Excel
    #38762403
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
В задачу не вчитывался детально, есть предположение, что надо ВСЕ покрасить красным, а потом совпадающие перекрасить зеленым

Да, и
Код: vbnet
1.
2.
3.
4.
                    If .Cells(i, "A") = Sh2.Cells(j, "A") Then
                        If .Cells(i, "B") = Sh2.Cells(j, "B") Then
                            If .Cells(i, "C") = Sh2.Cells(j, "C") Then
                                If .Cells(i, "D") = Sh2.Cells(j, "D") Then


легко меняется на
Код: vbnet
1.
If .Cells(i, "A") = Sh2.Cells(j, "A") AND .Cells(i, "B") = Sh2.Cells(j, "B") AND .Cells(i, "C") = Sh2.Cells(j, "C") AND .Cells(i, "D") = Sh2.Cells(j, "D") Then

курите логические выражения
...
Рейтинг: 0 / 0
Выделение не совпадающих строк в листах Excel
    #38762431
Vasek11
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Shocker.Pro, Покрасить тоже думал в красный цвет, но тут нужно именно найти и отметить строки.

Код: vbnet
1.
2.
3.
4.
5.
If .Cells(i, "A") = Sh2.Cells(j, "A") And .Cells(i, "B") = Sh2.Cells(j, "B") And .Cells(i, "C") = Sh2.Cells(j, "C") And .Cells(i, "D") = Sh2.Cells(j, "D") Then
	Sh2.Rows(j).Interior.ColorIndex = 4
ElseIf .Cells(i, "A") <> Sh2.Cells(j, "A") And .Cells(i, "B") <> Sh2.Cells(j, "B") And .Cells(i, "C") <> Sh2.Cells(j, "C") And .Cells(i, "D") <> Sh2.Cells(j, "D") Then
	Sh2.Rows(j).Interior.ColorIndex = 3
End If


Сейчас отмечает последние две строки зеленым, остальные все красные, что не правильно.
Тут либо куча условий ставить, либо как то в цикле смещения делать на следующую строку во втором листе при нахождении не совпадающего значения.
...
Рейтинг: 0 / 0
Выделение не совпадающих строк в листах Excel
    #38762457
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Vasek11Если все значения совпадают то окрасить зеленым цветом строку, иначе закрасить строку красным цветом.вот изначальное условие, если не зеленый, то красный. Поэтому я не понимаю, что вас не устраивает и зачем какие-то дополнительные условия?


а рассуждение "последние две строки" бессмысленны, так как вашего файла у нас нет, выкладывайте файл

Желательно выложить изначальный файл, а также раскрашенный так, как вы считаете правильным
...
Рейтинг: 0 / 0
Выделение не совпадающих строк в листах Excel
    #38762609
Vasek11
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Shocker.Pro, Приложил файл в нем сейчас на Листе 2 правильное раскрашивание строк. Если очистить стили и выполнить макрос то раскраска будет такова что, 3 строки будут красными и 1 последняя зеленая.
...
Рейтинг: 0 / 0
Выделение не совпадающих строк в листах Excel
    #38762632
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Потому что вы сравниваете все строки первого листа только с последней строкой второго листа.

Ну то есть вы во внутреннем цикле много раз перекрашиваете одну и ту же строку Sh2.Rows(j), пока она не примет конечный цвет соответствующий концу цикла - то есть последней строке.

Вам нужно прекращать внутренний цикл, как только найдено соответствие и красить строку в зеленый цвет. Если же соответствие не найдено - красить в красный.

(не пишу конкретный код, есть впечатление, что вы хотите разобраться сами)
...
Рейтинг: 0 / 0
Выделение не совпадающих строк в листах Excel
    #38762652
Vasek11
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Shocker.Pro, не совсем понимаю как правильно из цикла выйти. Может при любом совпадении, переходить на метку проверки полного совпадения строки и красить строку?

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
Dim Lr1&, Lr2&
Dim i&, j&
Dim Sh1 As Worksheet, Sh2 As Worksheet
Set Sh1 = Workbooks("Kniga.xlsm").Sheets("Лист1")
Set Sh2 = Workbooks("Kniga.xlsm").Sheets("Лист2")
    Application.ScreenUpdating = False
    Lr1 = Sh1.Range("A1").CurrentRegion.Rows.Count
    Lr2 = Sh2.Range("A1").CurrentRegion.Rows.Count
    With Sh1
        For i = 2 To Lr1
            For j = 2 To Lr2
                If Len(.Cells(i, "A")) Then
                    If .Cells(i, "A") = Sh2.Cells(j, "A") And .Cells(i, "B") = Sh2.Cells(j, "B") And .Cells(i, "C") = Sh2.Cells(j, "C") And .Cells(i, "D") = Sh2.Cells(j, "D") Then
                        Sh2.Rows(j).Interior.ColorIndex = 4
                        GoTo metka
                    Else
                        Sh2.Rows(j).Interior.ColorIndex = 3
                    End If
                Else: Exit Sub
                End If
metka:       Exit For
           Next j
       Next i
    End With
    Application.ScreenUpdating = True
End Sub
...
Рейтинг: 0 / 0
Выделение не совпадающих строк в листах Excel
    #38762656
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Vasek11Может при любом совпадении, переходить на метку проверки полного совпадения строки и красить строку?вообще, переход на метку - это плохой тон программирования, не привыкайте к этому. Для выхода из цикла используйте Exit For.
Можно просто ввести индикатор, что условие выполнилось. Если по окончании цикла индикатор не "горит", значит красить красным.

У вас же - опять. В каждой итерации вы пытаетесь перекрасить строку. Вам нужно красить строку ПОСЛЕ завершения внутреннего цикла, а не в процессе его выполнения.
...
Рейтинг: 0 / 0
Выделение не совпадающих строк в листах Excel
    #38762664
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Vasek11
Код: vbnet
1.
               Else: Exit Sub

по ходу дела - вот тут вы внезапно выходите их подпрограммы, забыв про ScreenUpdating
...
Рейтинг: 0 / 0
Выделение не совпадающих строк в листах Excel
    #38762682
Vasek11
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Shocker.Pro, Так сделал выделяет правильно только зеленым, красным не хочет

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
Dim Lr1&, Lr2&
Dim i&, j&, y&
Dim Sh1 As Worksheet, Sh2 As Worksheet
Set Sh1 = Workbooks("Kniga.xlsm").Sheets("&#203;&#232;&#241;&#242;1")
Set Sh2 = Workbooks("Kniga.xlsm").Sheets("&#203;&#232;&#241;&#242;2")
    Application.ScreenUpdating = False
    Lr1 = Sh1.Range("A1").CurrentRegion.Rows.Count
    Lr2 = Sh2.Range("A1").CurrentRegion.Rows.Count
    With Sh1
    y = 0
        For i = 2 To Lr1
            For j = 2 To Lr2
                If Len(.Cells(i, "A")) Then
                    If .Cells(i, "A") = Sh2.Cells(j, "A") And .Cells(i, "B") = Sh2.Cells(j, "B") And .Cells(i, "C") = Sh2.Cells(j, "C") And .Cells(i, "D") = Sh2.Cells(j, "D") Then
                        y = 1
                        GoTo metka
                    End If
                Else: Exit Sub
                End If
           Next j
metka:     If y = 1 Then
                Sh2.Rows(j).Interior.ColorIndex = 4
           Else
                Sh2.Rows(j).Interior.ColorIndex = 3
           End If
       Next i
    End With
    Application.ScreenUpdating = True
End Sub
...
Рейтинг: 0 / 0
Выделение не совпадающих строк в листах Excel
    #38762689
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
потому что после того, как переменная "y" стала 1, она больше никогда не станет 0

и эта, еще раз - вместо goto metka - Exit For
...
Рейтинг: 0 / 0
Выделение не совпадающих строк в листах Excel
    #38762695
Vasek11
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Shocker.Pro, Сейчас последняя пустая строка после записей красится красным, так же зелеными верно окрашивает, но есть явные строки без заливки красного цвета.

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
Dim Lr1&, Lr2&
Dim i&, j&, y&
Dim Sh1 As Worksheet, Sh2 As Worksheet
Set Sh1 = Workbooks("Kniga.xlsm").Sheets("Лист1")
Set Sh2 = Workbooks("Kniga.xlsm").Sheets("Лист2")
    Application.ScreenUpdating = False
    Lr1 = Sh1.Range("A1").CurrentRegion.Rows.Count
    Lr2 = Sh2.Range("A1").CurrentRegion.Rows.Count
    With Sh1
        For i = 2 To Lr1
            For j = 2 To Lr2
                If .Cells(i, "A") = Sh2.Cells(j, "A") And .Cells(i, "B") = Sh2.Cells(j, "B") And .Cells(i, "C") = Sh2.Cells(j, "C") And .Cells(i, "D") = Sh2.Cells(j, "D") Then
                    y = 1
                    Exit For
                Else
                    y = 0
                End If
           Next j
           If y = 1 Then
                Sh2.Rows(j).Interior.ColorIndex = 4
           Else
                Sh2.Rows(j).Interior.ColorIndex = 3
           End If
       Next i
    End With
    Application.ScreenUpdating = True
End Sub
...
Рейтинг: 0 / 0
Выделение не совпадающих строк в листах Excel
    #38762702
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
эхехе......... теперь это ничем не отличается от этого ...
индикатор надо сбросить перед началом цикла
...
Рейтинг: 0 / 0
Выделение не совпадающих строк в листах Excel
    #38762713
Vasek11
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Shocker.Pro, Без изменений эх.. перед двумя циклами определял. y = 0 и менял значение так для проверки.

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
Dim Lr1&, Lr2&
Dim i&, j&, y&
Dim Sh1 As Worksheet, Sh2 As Worksheet
Set Sh1 = Workbooks("Kniga.xlsm").Sheets("Лист1")
Set Sh2 = Workbooks("Kniga.xlsm").Sheets("Лист2")
    Application.ScreenUpdating = False
    Lr1 = Sh1.Range("A1").CurrentRegion.Rows.Count
    Lr2 = Sh2.Range("A1").CurrentRegion.Rows.Count
    With Sh1
        For i = 2 To Lr1
            For j = 2 To Lr2
              y = 0
                If .Cells(i, "A") = Sh2.Cells(j, "A") And .Cells(i, "B") = Sh2.Cells(j, "B") And .Cells(i, "C") = Sh2.Cells(j, "C") And .Cells(i, "D") = Sh2.Cells(j, "D") Then
                    y = 1
                    Exit For
                Else
                    y = 0
                End If
           Next j
           If y = 1 Then
                Sh2.Rows(j).Interior.ColorIndex = 4
           End If
           If y = 0 Then
               Sh2.Rows(j).Interior.ColorIndex = 3
           End If
       Next i
    End With
    Application.ScreenUpdating = True
End Sub
...
Рейтинг: 0 / 0
Выделение не совпадающих строк в листах Excel
    #38762721
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Да что ж вы никак не попадете-то? y=0 надо поставить перед началом анализа - то есть перед вторым циклом. Все остальные y=0 не нужны.

Теперь поехали дальше - а что нужно покрасить-то? Первый лист или второй? Потому что вы обрабатываете первый лист:
Код: vbnet
1.
For i = 2 To Lr1

а, вот красите почему-то второй:
Код: vbnet
1.
Sh2.Rows(j).Interior

Либо надо красить первый лист, либо вывернуть цикл наизнанку, то есть проходить по строкам второго листа, сравнивая его с первым, а не наоборот.
...
Рейтинг: 0 / 0
Выделение не совпадающих строк в листах Excel
    #38762729
Vasek11
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Shocker.Pro, Покрасить нужно второй лист, проверив совпадения с первым листом

эту часть тоже менял местами

Код: vbnet
1.
2.
3.
  For i = 2 To Lr1
            y = 0
            For j = 2 To Lr2




пока тоже самое...

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
Dim Lr1&, Lr2&
Dim i&, j&, y&
Dim Sh1 As Worksheet, Sh2 As Worksheet
Set Sh1 = Workbooks("Kniga.xlsm").Sheets("Лист1")
Set Sh2 = Workbooks("Kniga.xlsm").Sheets("Лист2")
    Application.ScreenUpdating = False
    Lr1 = Sh1.Range("A1").CurrentRegion.Rows.Count
    Lr2 = Sh2.Range("A1").CurrentRegion.Rows.Count
    With Sh1
        For i = 2 To Lr1
            y = 0
            For j = 2 To Lr2
                If .Cells(i, "A") = Sh2.Cells(j, "A") And .Cells(i, "B") = Sh2.Cells(j, "B") And .Cells(i, "C") = Sh2.Cells(j, "C") And .Cells(i, "D") = Sh2.Cells(j, "D") Then
                    y = 1
                    Exit For
                End If
           Next j
           If y = 1 Then
                Sh2.Rows(j).Interior.ColorIndex = 4
           End If
           If y = 0 Then
               Sh2.Rows(j).Interior.ColorIndex = 3
           End If
       Next i
    End With
    Application.ScreenUpdating = True
End Sub
...
Рейтинг: 0 / 0
Выделение не совпадающих строк в листах Excel
    #38762731
Vasek11
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Вроде бы заработало

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
Dim Lr1&, Lr2&
Dim i&, j&, y&
Dim Sh1 As Worksheet, Sh2 As Worksheet
Set Sh1 = Workbooks("Kniga.xlsm").Sheets("&#203;&#232;&#241;&#242;1")
Set Sh2 = Workbooks("Kniga.xlsm").Sheets("&#203;&#232;&#241;&#242;2")
    Application.ScreenUpdating = False
    Lr1 = Sh1.Range("A1").CurrentRegion.Rows.Count
    Lr2 = Sh2.Range("A1").CurrentRegion.Rows.Count
    With Sh1
        For j = 2 To Lr2
            y = 0
            For i = 2 To Lr1
                If .Cells(i, "A") = Sh2.Cells(j, "A") And .Cells(i, "B") = Sh2.Cells(j, "B") And .Cells(i, "C") = Sh2.Cells(j, "C") And .Cells(i, "D") = Sh2.Cells(j, "D") Then
                    y = 1
                    Exit For
                End If
           Next i
           If y = 1 Then
                Sh2.Rows(j).Interior.ColorIndex = 4
           End If
           If y = 0 Then
               Sh2.Rows(j).Interior.ColorIndex = 3
           End If
       Next j
    End With
    Application.ScreenUpdating = True
End Sub
...
Рейтинг: 0 / 0
Выделение не совпадающих строк в листах Excel
    #38762733
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ок
ну, до кучи это:Vasek11
Код: vbnet
1.
2.
3.
4.
5.
6.
           If y = 1 Then
                Sh2.Rows(j).Interior.ColorIndex = 4
           End If
           If y = 0 Then
               Sh2.Rows(j).Interior.ColorIndex = 3
           End If

можно заменить на это:
Код: vbnet
1.
Sh2.Rows(j).Interior.ColorIndex = IIf(y = 1, 4, 3)



а еще лучше - можно сразу цвет задавать:
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
        For j = 2 To Lr2
            y = 3
            For i = 2 To Lr1
                If .Cells(i, "A") = Sh2.Cells(j, "A") And .Cells(i, "B") = Sh2.Cells(j, "B") And .Cells(i, "C") = Sh2.Cells(j, "C") And .Cells(i, "D") = Sh2.Cells(j, "D") Then
                    y = 4
                    Exit For
                End If
           Next i
           Sh2.Rows(j).Interior.ColorIndex = y
       Next j

ну это уже оптимизации
...
Рейтинг: 0 / 0
Выделение не совпадающих строк в листах Excel
    #38762736
Vasek11
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Shocker.Pro, Спасибо Вам большое!
Долго и упорно, но сделал)
...
Рейтинг: 0 / 0
Выделение не совпадающих строк в листах Excel
    #38762738
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
...
Рейтинг: 0 / 0
Выделение не совпадающих строк в листах Excel
    #38762751
iMrTidy
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Vasek11,

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
Option Explicit

Public Sub CheckCells()
On Error GoTo ErrTrap

Dim Lr1 As Integer
Dim Lr2 As Integer
Dim r As Integer
Dim r2 As Integer
Dim c As Integer
Dim b As Boolean
Dim idx As Integer
Dim Sh1 As Worksheet
Dim Sh2 As Worksheet
Dim wbk As Workbook

Set wbk = ThisWorkbook
Set Sh1 = wbk.Sheets("Sheet1")
Set Sh2 = wbk.Sheets("Sheet2")

XlRfl False

Lr1 = Sh1.Range("A1").CurrentRegion.Rows.Count
Lr2 = Sh2.Range("A1").CurrentRegion.Rows.Count

For r = 2 To Lr2
    idx = 3
    For r2 = 2 To Lr1
        b = True
        For c = 1 To 4
            b = b * IIf(Sh1.Cells(r2, c).Value2 = Sh2.Cells(r, c).Value2, True, False)
            If Not b Then Exit For
        Next
        If b Then
            idx = 4
            Exit For
        End If
    Next
    Sh2.Rows(r).Interior.ColorIndex = idx
Next

ErrTrap:
    XlRfl True
End Sub

Private Sub XlRfl(Enabled As Boolean)

Application.ScreenUpdating = Enabled
Application.EnableEvents = Enabled
Application.Calculation = IIf(Enabled, xlCalculationAutomatic, xlCalculationManual)

End Sub

...
Рейтинг: 0 / 0
Выделение не совпадающих строк в листах Excel
    #38762770
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
iMrTidy,

Не согласен - это сокрытие любых ошибок, все равно что resume next воткнуть.

Лучше сделать обертку, которая выключает ScreenUpdating, вызывает основную функцию, включает ScreenUpdating (при необходимости, она же перехватывает исключения и выдает сообщение пользователю, а не так - молча)
...
Рейтинг: 0 / 0
Выделение не совпадающих строк в листах Excel
    #38762772
iMrTidy
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Shocker.Pro,

Да, возможно, концовку лучше заменить на:

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
Finally:
    XlRfl True

Exit Sub
ErrTrap:
    MsgBox Err.Number & " " & Err.Description
    GoTo Finally
End Sub
...
Рейтинг: 0 / 0
23 сообщений из 23, страница 1 из 1
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Выделение не совпадающих строк в листах Excel
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]