Сравнение и вставка значений

[danika24]

Здравствуйте нужна очень помощь. Есть Книга первые два листа с данными надо сравнить по колонке А обе листа . Вывести на 3 лист номера что есть во 2 листе но нет в 1 и наоборот. нашла интересный тут макрос но не знаю как его доделать чтобы работал у меня.
Приложение. Книга11 это моя что надо. Книга 1 это макрос что нашла. Таких книг около 100 и в ручную их не обработать помогите.

[mchip]

Желтым выделено то чего нет на другом листе....
и без всяких макросов

[Aleksandr H.]

Sub BuhEpo()
    Dim r As Long
    Dim shBuh, shEpo, shNetEpo, shNetBuh
    On Error Resume Next
    Application.EnableCancelKey = xlDisabled
    Application.ScreenUpdating = False
    Set shBuh = Sheets("бух")
    Set shEpo = Sheets("эпо")
    Set shNetEpo = Sheets("нет в эпо")
    Set shNetBuh = Sheets("есть в эпо нет в бух")
    r = 1
    For r = 1 To shBuh.Cells(shBuh.Rows.Count, 1).End(xlUp).Row
        If Application.CountIf(shEpo.Columns(1), shBuh.Cells(r, 1)) = 0 Then
            shNetEpo.Cells(shNetEpo.Cells(shNetEpo.Rows.Count, 1).End(xlUp).Row + 1, 1) = shBuh.Cells(r, 1)
        End If
    Next r
    r = 1
    For r = 1 To shEpo.Cells(shEpo.Rows.Count, 1).End(xlUp).Row
        If Application.CountIf(shBuh.Columns(1), shEpo.Cells(r, 1)) = 0 Then
            shNetBuh.Cells(shNetBuh.Cells(shNetBuh.Rows.Count, 1).End(xlUp).Row + 1, 1) = shEpo.Cells(r, 1)
        End If
    Next r
    Application.ScreenUpdating = True
    MsgBox "Done!"
End Sub

[danika24]

Спасибо вам Большое мои дорогие вы меня спасли от суток на работе.

[danika24]

Сообщение от Aleksandr H.

Sub BuhEpo()
    Dim r As Long
    Dim shBuh, shEpo, shNetEpo, shNetBuh
    On Error Resume Next
    Application.EnableCancelKey = xlDisabled
    Application.ScreenUpdating = False
    Set shBuh = Sheets("бух")
    Set shEpo = Sheets("эпо")
    Set shNetEpo = Sheets("нет в эпо")
    Set shNetBuh = Sheets("есть в эпо нет в бух")
    r = 1
    For r = 1 To shBuh.Cells(shBuh.Rows.Count, 1).End(xlUp).Row
        If Application.CountIf(shEpo.Columns(1), shBuh.Cells(r, 1)) = 0 Then
            shNetEpo.Cells(shNetEpo.Cells(shNetEpo.Rows.Count, 1).End(xlUp).Row + 1, 1) = shBuh.Cells(r, 1)
        End If
    Next r
    r = 1
    For r = 1 To shEpo.Cells(shEpo.Rows.Count, 1).End(xlUp).Row
        If Application.CountIf(shBuh.Columns(1), shEpo.Cells(r, 1)) = 0 Then
            shNetBuh.Cells(shNetBuh.Cells(shNetBuh.Rows.Count, 1).End(xlUp).Row + 1, 1) = shEpo.Cells(r, 1)
        End If
    Next r
    Application.ScreenUpdating = True
    MsgBox "Done!"
End Sub

А как написать чтобы он копировал не только номер серийный но и название?

[Aleksandr H.]

shNetEpo.Cells(shNetEpo.Cells(shNetEpo.Rows.Count, 1).End(xlUp).Row + 1, 1) = shBuh.Cells(r, 1)
shNetEpo.Cells(shNetEpo.Cells(shNetEpo.Rows.Count, 1).End(xlUp).Row + 1, 2) = shBuh.Cells(r, 2)

shNetBuh.Cells(shNetBuh.Cells(shNetBuh.Rows.Count, 1).End(xlUp).Row + 1, 1) = shEpo.Cells(r, 1)
shNetBuh.Cells(shNetBuh.Cells(shNetBuh.Rows.Count, 1).End(xlUp).Row + 1, 2) = shEpo.Cells(r, 2)

[danika24]

Спасибо большое понимаю что много прошу но заставили заполнять таблицу еще по этим данным . Надо чтобы заполнились поля таблицы в соответсвии с выборкой и взяли еще данные из листа данные о годе ввода в эксплуатацию.

[Aleksandr H.]

Кста, Вас не смутило, что описание на 1 строку сместилось вниз? Надо удалить с макроса "+1"

shNetEpo.Cells(shNetEpo.Cells(shNetEpo.Rows.Count, 1).End(xlUp).Row + 1, 2) = shBuh.Cells(r, 2)
shNetBuh.Cells(shNetBuh.Cells(shNetBuh.Rows.Count, 1).End(xlUp).Row + 1, 2) = shEpo.Cells(r, 2)

upd:

Sub ExceuteSlut()
    Dim shNetEpo, shTblNetEpo, shData
    Set shNetEpo = Sheets("нет в эпо")
    Set shTblNetEpo = Sheets("таблица нет в эпо")
    Set shData = Sheets("данные")
    
    hz shNetEpo, shTblNetEpo, shData
    
    Set shNetEpo = Sheets("есть в эпо нет в бух")
    Set shTblNetEpo = Sheets("таблица нет в бух")
    Set shData = Sheets("данные")
    hz shNetEpo, shTblNetEpo, shData
    MsgBox "done!"
End Sub

Sub hz(sh1, sh2, shData)
    Dim i, r, Pos As Long
    Dim arr As Variant, arr2 As Variant, N As Variant
    
    r = sh1.Cells(sh1.Rows.Count, 1).End(xlUp).Row
    For i = 2 To r
        With sh2
            .Cells(i, 6) = sh1.Cells(i, 1)
            
            arr = shData.Range("A1:C" & shData.Range("A35000").End(xlUp).Row)
            arr2 = Application.Index(arr, 0, 2)
            
            If IsError(Application.Match(Application.Trim(.Cells(i, 6)), arr2, 0)) Then
                Pos = 0
            Else
                Pos = Application.Match(Application.Trim(.Cells(i, 6)), arr2, 0)
            End If
            arr2 = Application.Index(arr, 0, 1)
            N = Application.Index(arr2, Pos, 1)
            .Cells(i, 1) = N
            
            arr2 = Application.Index(arr, 0, 3)
            N = Application.Index(arr2, Pos, 1)
            .Cells(i, 8) = N
            
        End With
    Next i
End Sub

[danika24]

Это я увидела исправила сама спасибо. Я мало что могу пока учусь. Спасибо вам большое.

[danika24]

Немного не то вышло с заполнением надо чтобы проставился год и тип оборудования который есть в списке данные имеено так как там есть.