Проблема с макросом

[kostmos]

Добрый день, форумчане

Подскажите, пожалуйста, что необходимо подкорректировать в следующем коде (цель данного макроса описана ниже), искал подобные темы, но не смог найти аналогичной проблемы, во всех случаях идет сопоставление 2-х столбцов, в моем случае задача немного иная.

Цель данного макроса: Сопоставить данные табеля, размещенного во вкладке Final с данными за аналогичный период электронного журнала во вкладке Month (необходимо чтобы в табеле выделялись цветом те даты, когда фактически по журналу входа не было посещения/отметок, т.е значение равно 0:00:00, а в табеле за указанную дату стоит значение больше 0. Любые другие значения больше 0:00:00, например 1:10:45, отмечаться не должны.) Кол-во сотрудников постоянно меняется.

Sub data_compare()

Dim x As String
Dim y As String

Dim arow As Integer
Dim wrow As Integer
Dim acol As Integer
Dim wcol As Integer

arow = 4
acol = 4
wrow = 4
wcol = 3


For arow = 4 To Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For acol = 3 To 18
        x = ActiveWorkbook.Worksheets("Month").Cells(arow, acol)
        y = ActiveWorkbook.Worksheets("Final").Cells(wrow, wcol)
        If x = "0" Then
            If y = "0" Then
                wcol = wcol + 1
            Else
                ActiveWorkbook.Worksheets("Final").Cells(wrow, wcol).Interior.Color = RGB(225, 15, 15)
                wcol = wcol + 1
            End If
        Else
            If y = "0" Then
                ActiveWorkbook.Worksheets("Final").Cells(wrow, wcol).Interior.Color = RGB(225, 15, 15)
                wcol = wcol + 1
            Else
                wcol = wcol + 1
            End If
        End If
    Next acol
wrow = wrow + 2
wcol = 3
Next arow
End Sub

Пример во вложении, буду признателен за помощь.

Заранее благодарю.

[alex77755]

Не так всё просто.
Особенно с такими примерами.
Если бы была гарантия, что таблицы на листах соответствуют друг другу.
А так такой макрос выдаст чушь!!

Екатеринова Екатерина Александровна на Month в августе присутствует, а на финале уже её нет. Значит всё что ниже неё по списку будет заполнено не правильно. Поэтому нужно делать проверки по работникам и по месяцам. Либо более тщательно подготавливать данные

[alex77755]

Sub сравнение()

Dim x As String
Dim y As String

Dim M(), Z(), R, C

M = Range(Лист1.Cells(3, 3), Лист1.Cells(Лист1.Cells(Rows.Count, 3).End(xlUp).Row, 18))
Z = Range(Лист2.Cells(3, 3), Лист2.Cells(Лист2.Cells(Rows.Count, 3).End(xlUp).Row, 18))
Range(Лист2.Cells(3, 3), Лист2.Cells(Лист2.Cells(Rows.Count, 3).End(xlUp).Row, 18)).Interior.ColorIndex = 0

For R = LBound(M) To UBound(M)
    For C = LBound(M, 2) To UBound(M, 2)
        x = M(R, C)
        y = Z(2 * R, C)
        If x = "0" Then
            If y <> "0" Then
                   Лист2.Cells(2 * R + 2, C + 2).Interior.Color = RGB(225, 15, 15)
            End If
        End If

Next C, R
End Sub

[kostmos]

Сообщение от alex77755

Не так всё просто.
Особенно с такими примерами.
Если бы была гарантия, что таблицы на листах соответствуют друг другу.
А так такой макрос выдаст чушь!!

Екатеринова Екатерина Александровна на Month в августе присутствует, а на финале уже её нет. Значит всё что ниже неё по списку будет заполнено не правильно. Поэтому нужно делать проверки по работникам и по месяцам. Либо более тщательно подготавливать данные

Alex, спасибо за ответ. На самом деле это я допустил ошибку, фактически кол-во месяцев во вкладке "month" и "final" всегда будет равным, т.е общее кол-во одинаковое.

Файл пересохранил, еще раз извиняюсь.

[kostmos]

Alex, использовал указанный Вами способ, все работает, еще раз спасибо!