//可识别单元格删除线,背景颜色
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