VBA - сравнить столбец предыдущего отчета с новым отчетом, чтобы найти новые записи

Question

У меня есть 4 листа, которые нужно использовать.

• ServerList1
• ServerList2
• MachineList1
• MachineList2

Названия листов с (1) рядом с ними являются отчетами за прошлую неделю, а имена листов с (2) рядом с ними являются отчетами за эту неделю.

На каждом листе есть несколько столбцов, от которых я избавляюсь, поэтому остается только столбец с Имя сервера или Имя машины

По сути, мне нужно сравнить отчет за последние недели с отчетом за эти недели и посмотреть, какие новые серверы были добавлены (если есть) и какие новые машины были добавлены (если есть).

И наоборот, мне нужно сделать наоборот, проверить, какие серверы были удалены (если есть) и какие машины были удалены (если есть) ..

С помощью приведенного ниже кода легко выполнить вторую часть, просто переключив имена рабочих листов.

Я нашел следующий код здесь:

https://www.ozgrid.com/forum/forum/help-forums/excel-vba-macros/145223-compare-2-columns-in-different-sheets-and-copy-entire-rows-into-new-sheets

Этот код выполняет сравнение и копирует новые появления, но есть две проблемы, с которыми я сейчас сталкиваюсь:

1) Код выглядит так, как будто он застрял в бесконечном цикле - мне нужно выйти из кода вручную

2) На листе Новые серверы-машины результаты вставляются из строки A2 вместо A1

Sub compareSheets()

    ThisWorkbook.RefreshAll
    Dim rng As Range, c As Range, cfind As Range

    Dim ws1 As Worksheet

    Set ws1 = Worksheets("New Servers-Machines")

    On Error Resume Next

    With Worksheets("Last Week Servers")

        Set rng = .Range(.Range("A1"), .Range("c1").End(xlDown))

        For Each c In rng
            c = Replace(c, " ", "")

            With Worksheets("This Week Servers")
                Set cfind = .Columns("A:A").Cells.Find(what:=c.Value, lookat:=xlWhole)

                If cfind Is Nothing Then
                    c.Resize(1, 1).EntireRow.Copy
                    ws1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                End If
            End With
        Next c

        Application.CutCopyMode = False

    End With

    With Worksheets("This Week Servers")

        Set rng = .Range(.Range("A1"), .Range("c1").End(xlDown))

        For Each c In rng
            c = Replace(c, " ", "")

            With Worksheets("Last Week Servers")
                Set cfind = .Columns("A:A").Cells.Find(what:=c.Value, lookat:=xlWhole)

                If cfind Is Nothing Then
                    c.Resize(1, 1).EntireRow.Copy
                    ws1.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                End If
            End With
        Next c

        Application.CutCopyMode = False

    End With

End Sub

UPDATE:

Public Sub FindDifferences1()

    Dim firstRange As Range
    Dim secondRange As Range
    Dim myCell As Range

    Dim wks1 As Worksheet, wks2 As Worksheet, wks3 As Worksheet

    'Find Removed Wintel Servers
    Set wks1 = ActiveWorkbook.Sheets("Last Week Servers List")
    Set wks2 = ActiveWorkbook.Sheets("This Week Servers List")
    Set wks3 = ActiveWorkbook.Sheets("New Servers")

    Set firstRange = wks1.Range("A:A")
    Set secondRange = wks2.Range("A:A")

    For Each myCell In firstRange
        If myCell <> secondRange.Range(myCell.Address) Then

            myCell.Copy

            wks3.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            wks3.Cells(Rows.Count, 2).End(xlUp).PasteSpecial xlPasteFormats

        End If
    Next myCell

End Sub

Формат листов - только один столбец с заголовком строки Имя сервера

Answer 1

Предположим, у вас есть 3 рабочих листа:

• worksheet1 - сравнить с worksheet2
• worksheet2 - сравнить с worksheet1
• worksheet3 - записать значения, отличающиеся в worksheet1

Тогда немного простого кода, так как этот работает вполне нормально:

Public Sub FindDifferences()

    Dim firstRange As Range
    Dim secondRange As Range

    Dim wks1 As Worksheet: Set wks1 = Worksheets(1)
    Dim wks2 As Worksheet: Set wks2 = Worksheets(2)
    Dim wks3 As Worksheet: Set wks3 = Worksheets(3)

    Set firstRange = wks1.UsedRange
    Set secondRange = wks2.UsedRange

    Dim myCell  As Range

    For Each myCell In firstRange
        If myCell <> secondRange.Range(myCell.Address) Then
            wks3.Range(myCell.Address) = myCell
        End If
    Next myCell

End Sub

Что это делает?

• if проходит через каждую ячейку UsedRange в Worksheets(1) и сравнивает ее с той же ячейкой в ​​Worksheets(2);
• если сравнение отличается, то записывается ячейка из Worksheets(1) в Worksheets(3);
• вы можете рассмотреть окраску ячейки в Worksheets(1), если также отличается;

---

Если ваши столбцы находятся в разных местах, поэтому вы хотели бы сравнить столбец B со столбцом D, то необходимо немного сократить диапазоны:

Set firstRange = wks1.UsedRange.Columns(2).Cells
Set secondRange = wks1.UsedRange.Columns(4).Cells

For Each myCell In firstRange
    If myCell.Value2 <> secondRange.Cells(myCell.Row, secondRange.Column).Value2 Then
        wks3.Range(myCell.Address) = myCell.Value2
    End If
Next myCell