Question

我总共有4张需要使用的纸张。

ServerList1
ServerList2
MachineList1
MachineList2

其旁边带有（1）的工作表名称是上周的报告，其旁边带有（2）的工作表名称是本周的报告。

在每张工作表中，我删除了多个列，以便剩下的所有列都是具有服务器名称或计算机名称

基本上，我需要将上周报告与本周报告进行比较，看看添加了哪些新服务器（如果有的话）以及添加了哪些新机器（如果有的话）。

相反，我需要做相反的事情，检查已删除的服务器（如果有的话）以及已删除的机器（如果有的话）..

使用下面的代码，只需切换工作表名称即可轻松完成第二部分。

我在这里找到了以下代码：

此代码进行比较并复制新的外观，但我目前遇到两个问题：

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

更新

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

VBA - 将先前报告中的列与新报告进行比较以查找新条目

1 个答案: