obrabotka_zp_vedomost

Sub FilterDataExcludeValues()

    Dim SourceSheet As Worksheet
    Dim DestSheet As Worksheet
    Dim LastRow As Long
    Dim DestRow As Long
    Dim i As Integer
    Dim j As Long
    Dim ExcludeValues As Variant
    Dim HeaderWritten As Boolean
    
    ' Создаем новый лист "Результат"
    Set DestSheet = ThisWorkbook.Worksheets.Add
    DestSheet.Name = "Результат"
    
    ' Задаем значения для исключения
    ExcludeValues = Array("Чагулина В.Р", "Проект", _
                          "[Проекты текущего месяца]", _
                          "[Проекты прошлого месяца]", _
                          "[Сложные проекты]", _
                          "ID 3 Шегурова. ОТ НН и Н обл", _
                          "[Доплаты]", _
                          "[От прочих специалистов]", _
                          "Итого", "ЗП начислено", "В фонд", _
                          "ЗП к получению", "Фонд на начало месяца", _
                          "Фонд на конец месяца", _
                          "[Начисление ФОТ прочим специалистам]", "Шегурова", _
                          "Чагулина В.Р", "Проект", "Номер договора", _
                          "Байкина", "Больничный", "Борисов", _
                          "Борисова", "Валера", "Влера", _
                          "Занозин", "Занозин ", "Князева Лилия", _
                          "Колокольникова", "Мария Кононюк (осмотр квартиры)", _
                          "Маслов", "Паномарев", "Получено отпускных", _
                          "Рамейкин", "Редькин", "Стас", _
                          "Стасу", "Тимофеева", "Фомин", _
                          "Шегурова", "Шегурова (ООО Норд Сервис)", "Шеститко", _
                          "Шустер", "Юрина")
    
    ' Инициализируем начальную строку для записи на листе назначения
    DestRow = 1
    
    ' Инициализируем переменную, чтобы проверить, написаны ли заголовки
    HeaderWritten = False
    
    ' Перебираем все листы
    For Each SourceSheet In ThisWorkbook.Worksheets
        If SourceSheet.Name <> DestSheet.Name Then
            
            ' Находим последнюю строку на исходном листе
            LastRow = SourceSheet.Cells(SourceSheet.Rows.Count, "A").End(xlUp).Row
            
            ' Перебираем все строки на исходном листе
            For i = 1 To LastRow
                ' Если значение ячейки столбца B не содержится в массиве исключаемых значений
                If IsError(Application.Match(SourceSheet.Cells(i, 2).Value, ExcludeValues, 0)) Then
                    ' Проверяем, написаны ли заголовки. Если нет, и текущая строка содержит заголовки, то копируем их
                    If Not HeaderWritten And SourceSheet.Cells(i, 1).Value = "Номер договора" And SourceSheet.Cells(i, 2).Value = "Проект" Then
                        SourceSheet.Rows(i).Copy DestSheet.Rows(DestRow)
                        DestRow = DestRow + 1
                        HeaderWritten = True
                    ElseIf SourceSheet.Cells(i, 1).Value <> "" Or SourceSheet.Cells(i, 2).Value <> "" Then
                        ' Если это не заголовки и строки не пустые, копируем строки
                        SourceSheet.Rows(i).Copy DestSheet.Rows(DestRow)
                        DestRow = DestRow + 1
                    End If
                End If
            Next i
        End If
    Next SourceSheet
    
    ' Удаляем строки с "Номер договора" начиная с 3 строки
    LastRow = DestSheet.Cells(DestSheet.Rows.Count, "A").End(xlUp).Row
    For j = LastRow To 3 Step -1
        If DestSheet.Cells(j, 1).Value = "Номер договора" Then
            DestSheet.Rows(j).Delete
        End If
    Next j

    MsgBox "Данные успешно отфильтрованы!", vbInformation

End Sub