VBA-将以前的报告与新报告中的列进行比较以查找新条目 [英] VBA - Compare Column on Previous Report With New Report to Find New Entries

问题描述

我总共需要使用4张纸.

• ServerList1
• ServerList2
• MachineList1
• MachineList2

旁边带有(1)的工作表名称是上周的报告，旁边带有(2)的工作表名称是本周的报告.

在每张工作表中，都删除了多列，因此剩下的就是具有服务器名称或计算机名称

本质上，我需要将上周报告与本周报告进行比较，并查看已添加了哪些新服务器(如果有)以及已添加了哪些新机器(如果有).

相反，我需要做相反的事情，检查已删除了哪些服务器(如果有)和已删除了哪些机器(如果有)..

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

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

https://www.ozgrid.com/forum/forum/help-forums/excel-vba-macros/145223-compare-2-columns-in-将不同的表格和副本整个行复制到新的表格中

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

1)代码看起来陷入了无限循环-我需要手动退出代码

2)在新服务器机器表上，将结果粘贴到A2行而不是A1

  Sub compareSheets()ThisWorkbook.RefreshAll调光为范围，c为范围，cfind为范围昏暗的ws1作为工作表设置ws1 =工作表(新服务器机器")关于错误继续使用工作表(上周服务器")设置rng = .Range(.Range("A1")，.Range("c1").End(xlDown))对于每一次c =替换(c，"，")使用工作表(本周服务器")设置cfind = .Columns("A:A").Cells.Find(内容:= c.Value，查找:= xlWhole)如果cfind什么都没有，那么c.Resize(1，1).EntireRow.Copyws1.Cells(Rows.Count，1).End(xlUp).Offset(1，0).PasteSpecial xlPasteValues万一结束于下一个cApplication.CutCopyMode =假结束于使用工作表(本周服务器")设置rng = .Range(.Range("A1")，.Range("c1").End(xlDown))对于每一次c =替换(c，"，")使用工作表(上周服务器")设置cfind = .Columns("A:A").Cells.Find(内容:= c.Value，查找:= xlWhole)如果cfind什么都没有，那么c.Resize(1，1).EntireRow.Copyws1.Cells(Rows.Count，2).End(xlUp).Offset(1、0).PasteSpecial xlPasteValues万一结束于下一个cApplication.CutCopyMode =假结束于结束子 

更新:

 公共子FindDifferences1()昏暗firstRange As范围昏暗secondRange作为范围昏暗的myCell作为范围昏暗的wks1作为工作表，wks2作为工作表，wks3作为工作表'查找已删除的Win​​tel服务器设置wks1 = ActiveWorkbook.Sheets(上周服务器列表")设置wks2 = ActiveWorkbook.Sheets(本周服务器列表")设置wks3 = ActiveWorkbook.Sheets(新服务器")设置firstRange = wks1.Range("A:A")设置secondRange = wks2.Range("A:A")对于firstRange中的每个myCell如果myCell<>secondRange.Range(myCell.Address)然后myCell.Copywks3.Cells(Rows.Count，2).End(xlUp).Offset(1，0).PasteSpecial xlPasteValueswks3.Cells(Rows.Count，2).End(xlUp).PasteSpecial xlPasteFormats万一下一个myCell结束子 

工作表的格式只有一列，并带有行标题服务器名称

解决方案

让我们假设您有3个工作表:

• worksheet1 -与 worksheet2
进行比较
• worksheet2 -与 worksheet1
进行比较
• worksheet3 -编写与 worksheet1
不同的值

然后编写一些简单的代码就可以了:

 公共子FindDifferences()昏暗firstRange As范围昏暗secondRange作为范围昏暗的wks1作为工作表:设置wks1 =工作表(1)昏暗的wks2作为工作表:设置wks2 =工作表(2)昏暗的wks3作为工作表:设置wks3 =工作表(3)设置firstRange = wks1.UsedRange设置secondRange = wks2.UsedRange昏暗的myCell作为范围对于firstRange中的每个myCell如果myCell<>secondRange.Range(myCell.Address)然后wks3.Range(myCell.Address)= myCell万一下一个myCell结束子 

它是做什么的?

• if循环遍历 Worksheets(1)中 UsedRange 的每个单元格，并将其与 Worksheets(2)中的相同单元格进行比较;
• 如果比较不同，则将 Worksheets(1)中的单元格写入 Worksheets(3);
• 如果也有所不同，您可以考虑为 Worksheets(1)中的单元格着色；

---

如果列位于不同的位置，那么您想将列 B 与列 D 进行比较，则需要对范围进行一些调整:

 设置firstRange = wks1.UsedRange.Columns(2).Cells设置secondRange = wks1.UsedRange.Columns(4).Cells对于firstRange中的每个myCell如果myCell.Value2<>secondRange.Cells(myCell.Row，secondRange.Column).Value2然后wks3.Range(myCell.Address)= myCell.Value2万一下一个myCell 

I have 4 sheets in total that need to be used.

• ServerList1
• ServerList2
• MachineList1
• MachineList2

The sheet names with a (1) next to them are the reports from last week and the sheet names with a (2) next to them are the reports from this week.

In each sheet, there are multiple columns which I get rid of so that all that remains is the column with either the Server Name or the Machine Name

Essentially, I need to compare last weeks report with this weeks report and see what new servers have been added (if any) and what new machines have been added (if any).

Conversely, I need to do the opposite, check what servers have been removed (if any) and what machines have been removed (if any)..

With the below code, it should be simple to accomplish the second part simply by switching the worksheet names..

I found the below code here:

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

This code does a comparison and copies the new appearances, but there's two issues I am currently experiencing:

1) The code looks like it gets stuck in an infinite loop - I need to exit the code manually

2) On the New Servers-Machines sheet, the results are pasted from row A2 instead of 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

Format of the sheets is only one column with a row header Server Name

解决方案

Let's assume that you have 3 worksheets:

• worksheet1 - to compare with worksheet2
• worksheet2 - to compare with worksheet1
• worksheet3 - to write the values, which are different in worksheet1

Then some simple code as this one works quite ok:

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

What does it do?

• if loops through every cell of the UsedRange in Worksheets(1) and it compares it with the same cell in Worksheets(2);
• if the comparison is different, then it writes the cell from Worksheets(1) in Worksheets(3);
• you may consider coloring the cell in Worksheets(1), if different as well;

---

If your columns are on different places, thus you would like to compare column B with column D, then a bit crunching of the ranges is needed:

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-将以前的报告与新报告中的列进行比较以查找新条目的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！