EXCEL单元格对比函数

//可识别单元格删除线，背景颜色
Function CompareCells(c1 As Range, c2 As Range) As Boolean
    Dim i As Integer, has_line As Boolean
    has_line = False
    
    
    
    If CompareCellFormats(c1, c2) <> True Then
        CompareCells = False
        Exit Function
    End If
    
    If isEmpty(c1.Value) And isEmpty(c2.Value) Then
        CompareCells = True
    End If
    
     If c1.Value <> c2.Value Then
        CompareCells = False '如果值不同，则直接返回False
        Exit Function
    End If
    
    
    For i = 1 To Len(c1.Value)
        ' 判断字符是否相同
        If Mid(c1.Value, i, 1) <> Mid(c2.Value, i, 1) Then
            CompareCells = False
            Exit Function
        End If
        ' 判断删除线是否相同
        If c1.Characters(i, 1).Font.Strikethrough <> c2.Characters(i, 1).Font.Strikethrough Then
            ' 如果一个有删除线而另一个没有，那么认为它们不相同
            If c1.Characters(i, 1).Font.Strikethrough = True Or c2.Characters(i, 1).Font.Strikethrough = True Then
                CompareCells = False
                Exit Function
            End If
        Else
            ' 如果字母都没有删除线，则认为它们相同
            If c1.Characters(i, 1).Font.Strikethrough = False Then
                CompareCells = True
            Else
                ' 如果字母都有删除线，则认为它们相同
                If has_line = False Then
                    CompareCells = True
                    has_line = True
                End If
            End If
        End If
    Next i
End Function


Function CompareCellFormats(cell1 As Range, cell2 As Range) As Boolean
   
    If cell1.Interior.Color = cell2.Interior.Color Then
        CompareCellFormats = True
    Else
        CompareCellFormats = False
    End If
End Function


'Interior.Color: 单元格的背景颜色
'Font.Color: 单元格中字体的颜色
'NumberFormat: 单元格格式设置中的数字格式
'Font.Bold: 字体加粗
'Font.Italic: 字体倾斜
'Font.Underline: 字体下划线
'WrapText: 是否自动换行
'HorizontalAlignment: 水平对齐方式
'VerticalAlignment: 垂直对齐方式
'Font.Name: 字体名称
'Font.Size: 字体大小

//查看当前excel sheet中是否有图片和形状，并计数
Function GetShapesAndPicturesCount() As String
    Dim wks As Worksheet
    Set wks = ActiveSheet
    
    Dim pictureCount As Integer
    Dim shapeCount As Integer
    
    '检查图片
    If wks.Shapes.Count > 0 Then
       pictureCount = wks.Shapes.Count
    Else
        pictureCount = 0
    End If
    
    '检查形状
    If wks.DrawingObjects.Count > 0 Then
        shapeCount = wks.DrawingObjects.Count
    Else
        shapeCount = 0
    End If
    
    GetShapesAndPicturesCount = "该sheet中共有" & pictureCount & "张图片或" & shapeCount & "个形状。请担当手动识别差分"
End Function