下面的代码将复制活动工作表，然后标记公式，使用阴影显示已复制哪些以及从何处复制。它从左到右、从上到下进行核查。
- 纯色 = 此单元格尚未从左侧或上方复制，即它是新的
- 水平剖面线 = 此单元格已从左侧复制
- 垂直剖面线 = 此单元格已从上方复制
- 交叉影线 = 此单元格已从左侧 上方复制
这个想法的目的是为了更容易检查复杂的工作表，因为你只需要检查纯色单元格，然后确认它们已被正确复制。如果表中间有一个公式损坏的单元格，它将是一个非常明显的纯色。
显然，代码复制了工作表，然后逐个查看每一单元格，首先从左侧复制公式，然后从上方复制，看看它是否给出相同的结果。这有点慢，但它是检查公式是否被完全复制的唯一可靠方法。
下面给出了一个示例，在表格中间包含一个具有不同公式的“特殊”单元格。
完整的代码如下：
Sub MarkFormulae()
Dim V As Variant
Dim rng As Range
Dim S As Worksheet
Dim i As Long
Dim j As Long
Dim r As Long
Dim C As Long
Dim ii As Long
Dim jj As Long
Dim n As Long
Dim skip As Boolean
Dim vbLeft As Long
Dim vbAbove As Long
vbLeft = 1
vbAbove = 2
Dim colorLeft As Long
Dim colorAbove As Long
Dim colorBoth As Long
Dim colorNone As Long
colorLeft =16773571
colorAbove= 10092543
colorBoth =6750054
colorNone =9486586
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.Copy
Set S =ActiveSheet
S.Cells.UnMerge
Cells.Interior.Color = xlNone
V =Range(Cells(1, 1), S.Cells.SpecialCells(xlCellTypeLastCell).Offset(1,1)).Formula
r =UBound(V, 1)
C =UBound(V, 2)
ReDim A(r,C) As Long
For i = 1 To r - 1
Application.StatusBar = "Processing " & S.Name &": row " & i & " of " & r
For j = 1 To C - 1
If Left$(V(i, j), 1) = "=" Then
Cells(i, j).Copy
Cells(i, j 1).PasteSpecial Paste:=xlPasteFormulas
If Cells(i, j 1).Formula = V(i, j 1) Then
A(i, j 1) = A(i, j 1) Or vbLeft
End If
Cells(i, j 1).Formula = V(i, j 1)
Cells(i, j).Copy
On Error Resume Next
Cells(i 1, j).PasteSpecial Paste:=xlPasteFormulas
skip= (Err.Number <> 0)
On Error GoTo 0
If skip = False Then
If Cells(i 1, j).Formula = V(i 1, j) Then
A(i 1, j) = A(i 1, j) Or vbAbove
End If
Cells(i 1, j).Formula = V(i 1, j)
Select Case A(i, j)
Case vbLeft
Cells(i, j).Interior.Pattern = xlLightHorizontal
Cells(i, j).Interior.PatternColor = 6737151
Case vbAbove
Cells(i, j).Interior.Pattern = xlLightVertical
Cells(i, j).Interior.PatternColor = 6737151
Case vbLeft vbAbove
Cells(i, j).Interior.Pattern = xlGrid
Cells(i, j).Interior.PatternColor = 6737151
Case Else
Cells(i, j).Interior.Color = colorNone
End Select
End If
End If
Next j
DoEvents
Next i
Application.CutCopyMode = False
Cells(1,1).Select
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.StatusBar = False
End Sub
注：本程序整理自www.mrexcel.com，供学习参考。
