VBA比较两张相同结构表格差异并标红

可根据具体使用情况修改“Set compareRange = wsCurrent.Range("A5:AC17")”，括号内为比较范围

Option Explicit
    
    
    Public Sub 比较两张表格差异()
        ' --- 变量声明 ---
        Dim wsCurrent As Worksheet
        Dim wsPrevious As Worksheet
        Dim compareRange As Range
        Dim cell As Range
        Dim previousSheetName As String
        Dim previousCellValue As Variant
        Dim differencesFound As Long
        Dim commentText As String 

        Set wsCurrent = Application.ActiveSheet
        differencesFound = 0
        
        ' --- 检查是否存在前一个工作表 ---
        If wsCurrent.Index = 1 Then
            MsgBox "错误：当前工作表是第一个工作表，没有可以用于比较的前一张表。", vbCritical, "操作中止"
            Exit Sub
        End If
        
        ' --- 设置工作表和范围 ---
        Set wsPrevious = ThisWorkbook.Worksheets(wsCurrent.Index - 1)
        previousSheetName = wsPrevious.Name
        Set compareRange = wsCurrent.Range("A5:AC17")
        
        Application.ScreenUpdating = False
        
        For Each cell In compareRange
            previousCellValue = wsPrevious.Range(cell.Address).Value
            If StrComp(CStr(cell.Value), CStr(previousCellValue), vbTextCompare) <> 0 Then
                differencesFound = differencesFound + 1
                
                ' 1. 设置背景色
                cell.Interior.Color = RGB(255, 199, 206) ' Light Red
                
                ' 2. 添加批注 ()
                If IsError(previousCellValue) Then
                    ' 如果是错误值，则生成特定的批注内容
                    commentText = "在“" & previousSheetName & "”工作表中为：" & vbCrLf & "一个错误值 (例如 #N/A)"
                Else
                    ' 如果不是错误值，则按原计划生成批注
                    commentText = "在“" & previousSheetName & "”工作表中为：" & vbCrLf & "“" & CStr(previousCellValue) & "”"
                End If
                
                ' 添加或更新批注
                If Not cell.Comment Is Nothing Then
                    cell.Comment.Delete
                End If
                cell.AddComment
                cell.Comment.Text Text:=commentText
                cell.Comment.Shape.TextFrame.AutoSize = True
                
            Else
                ' 如果值一致，清除格式和批注
                cell.Interior.ColorIndex = xlNone
                If Not cell.Comment Is Nothing Then
                    cell.Comment.Delete
                End If
            End If
        Next cell
        
        Application.ScreenUpdating = True
        
        If differencesFound > 0 Then
            MsgBox "比对完成！共发现 " & differencesFound & " 处差异。", vbInformation, "比对成功"
        Else
            MsgBox "比对完成！未发现任何差异。", vbInformation, "比对成功"
        End If
        
    End Sub