VBA开发需求：对比新旧报表列筛选新增服务器与设备条目

Hey there, based on your requirement to compare last week's (the *1 suffix sheets) and this week's (the *2 suffix sheets) server/machine lists, here's a straightforward VBA script that'll do the heavy lifting for you. I'll break it down so you can follow along easily.

Assumptions Before We Start #

• Each of your four sheets has only one column (Column A) with the server/machine names, starting from row 2 (row 1 is the header like "Server Name" or "Machine Name").
• We'll create two new sheets to store the results: NewServers and NewMachines, so you can clearly see what's been added this week.

Full VBA Code #

Open your Excel file, press Alt + F11 to open the VBA editor, insert a new module (right-click your workbook in the Project Explorer > Insert > Module), then paste this code:

Sub FindNewEntries()
    Dim wsLastWeek As Worksheet, wsThisWeek As Worksheet
    Dim wsResult As Worksheet
    Dim lastRow As Long, i As Long
    Dim entryDict As Object
    
    ' Initialize dictionary for fast entry lookup
    Set entryDict = CreateObject("Scripting.Dictionary")
    
    ' --- Process Server Lists ---
    ' Link to last week's and this week's server sheets
    Set wsLastWeek = ThisWorkbook.Worksheets("ServerList1")
    Set wsThisWeek = ThisWorkbook.Worksheets("ServerList2")
    
    ' Create or reuse the NewServers results sheet
    On Error Resume Next
    Set wsResult = ThisWorkbook.Worksheets("NewServers")
    If Err.Number <> 0 Then
        Set wsResult = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
        wsResult.Name = "NewServers"
        wsResult.Range("A1").Value = "New Servers Added This Week"
    End If
    On Error GoTo 0
    
    ' Clear old results (keep header intact)
    wsResult.Range("A2:A" & wsResult.Cells(wsResult.Rows.Count, "A").End(xlUp).Row).ClearContents
    
    ' Populate dictionary with last week's server entries
    lastRow = wsLastWeek.Cells(wsLastWeek.Rows.Count, "A").End(xlUp).Row
    For i = 2 To lastRow
        If Not entryDict.Exists(Trim(wsLastWeek.Cells(i, "A").Value)) Then
            entryDict.Add Trim(wsLastWeek.Cells(i, "A").Value), 1
        End If
    Next i
    
    ' Check this week's servers for new entries
    lastRow = wsThisWeek.Cells(wsThisWeek.Rows.Count, "A").End(xlUp).Row
    Dim resultRow As Long
    resultRow = 2
    For i = 2 To lastRow
        Dim currentEntry As String
        currentEntry = Trim(wsThisWeek.Cells(i, "A").Value)
        If currentEntry <> "" And Not entryDict.Exists(currentEntry) Then
            wsResult.Cells(resultRow, "A").Value = currentEntry
            resultRow = resultRow + 1
        End If
    Next i
    
    ' Reset dictionary for machine list comparison
    entryDict.RemoveAll
    
    ' --- Process Machine Lists ---
    ' Link to last week's and this week's machine sheets
    Set wsLastWeek = ThisWorkbook.Worksheets("MachineList1")
    Set wsThisWeek = ThisWorkbook.Worksheets("MachineList2")
    
    ' Create or reuse the NewMachines results sheet
    On Error Resume Next
    Set wsResult = ThisWorkbook.Worksheets("NewMachines")
    If Err.Number <> 0 Then
        Set wsResult = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
        wsResult.Name = "NewMachines"
        wsResult.Range("A1").Value = "New Machines Added This Week"
    End If
    On Error GoTo 0
    
    ' Clear old results (keep header intact)
    wsResult.Range("A2:A" & wsResult.Cells(wsResult.Rows.Count, "A").End(xlUp).Row).ClearContents
    
    ' Populate dictionary with last week's machine entries
    lastRow = wsLastWeek.Cells(wsLastWeek.Rows.Count, "A").End(xlUp).Row
    For i = 2 To lastRow
        If Not entryDict.Exists(Trim(wsLastWeek.Cells(i, "A").Value)) Then
            entryDict.Add Trim(wsLastWeek.Cells(i, "A").Value), 1
        End If
    Next i
    
    ' Check this week's machines for new entries
    lastRow = wsThisWeek.Cells(wsThisWeek.Rows.Count, "A").End(xlUp).Row
    resultRow = 2
    For i = 2 To lastRow
        currentEntry = Trim(wsThisWeek.Cells(i, "A").Value)
        If currentEntry <> "" And Not entryDict.Exists(currentEntry) Then
            wsResult.Cells(resultRow, "A").Value = currentEntry
            resultRow = resultRow + 1
        End If
    Next i
    
    ' Cleanup objects
    Set entryDict = Nothing
    MsgBox "Comparison complete! Check the NewServers and NewMachines sheets for results.", vbInformation
End Sub

How This Script Works #

• Fast Lookup with Dictionary: We use a Scripting.Dictionary to store all entries from last week's sheet—this makes checking if an entry exists way faster than looping through every row each time.
• Auto-Managed Result Sheets: The script creates NewServers and NewMachines sheets if they don't exist, or clears old results if they do (so you can run this weekly without manual cleanup).
• Space Tolerance: Trim() removes extra spaces from entry names, so "Server01" and " Server01 " are treated as the same entry.
• Blank Cell Skip: The script ignores empty cells in your lists, so you won't get empty rows in the results.

How to Run #

1. Save your Excel file as a Macro-Enabled Workbook (.xlsm) if it isn't already.
2. Press Alt + F8, select FindNewEntries, then click "Run".
3. A message box will pop up when it's done—head to the new sheets to see your new entries!

If your server/machine names are in a different column (e.g., Column B), just replace all instances of "A" in the code with your target column letter.

内容的提问来源于stack exchange，提问作者TurboCoder