突出显示变体数组中的单元格

本质上，这段代码从一个工作表中的一个范围中取一堆值，并将它们粘贴到另一个相同范围的工作表中。 但是这更像是一个特殊的粘贴，因为这段代码只粘贴到空的单元格中，而不是已经包含另一个表单中的值的单元格。 这是使用不同的数组（我喜欢@Jeeped帮助我）我的问题是，我需要在运行代码时，在目标工作表中突出显示与源工作表中的值不同的单元格。 这是为了防止我为会计师事务所工作时的欺诈行为。 非常感谢你的帮助！

这是我到目前为止：

Sub fill_blanks_from_source() Dim r As Long, c As Long, aSRCs As Variant, aDSTs As Variant With Worksheets("Sheet1") '<~~ source aSRCs = .Range("C6:R371").Value2 End With With Worksheets("Sheet2") '<~~ destination aDSTs = .Range("D9").Resize(UBound(aSRCs, 1), UBound(aSRCs, 2)).Value2 End With For r = LBound(aDSTs, 1) To UBound(aDSTs, 1) For c = LBound(aDSTs, 2) To UBound(aDSTs, 2) If IsEmpty(aDSTs(r, c)) Then aDSTs(r, c) = aSRCs(r, c) End If Next c Next r With Worksheets("Sheet2") .Range("D9").Resize(UBound(aDSTs, 1), UBound(aDSTs, 2)) = aDSTs End With End Sub 

再次，我想添加一些东西，允许代码在单元格的值不匹配时读取，然后突出显示目标源中的给定单元格为红色，并在空单元格中粘贴新值

我知道这是错误的，但基本上这是一个抽象思想的想法

 If IsEmpty(aDSTs(r, c)) = True Then aDSTs(r, c) = aSRCs(r, c) ElseIf aDSTs(r, c) <> aSRCs(r, c) Then Worksheets("Sheet2").Range("D9").Resize(r, c).Cells.Interior.ColorIndex = 3 ElseIf aDSTs(r, c) = aSRCs(r, c) Then End If 

Answer 1

在单元中循环将是耗时的。 通过Union方法收集它们，至less可以一次执行实际的格式化操作。

 Sub fill_blanks_from_source() Dim r As Long, c As Long, aSRCs As Variant, aDSTs As Variant Dim rngBLNK As Range, ws2 As Worksheet Dim iFirstDestinationRow As Long, iFirstDestinationColumn As Long 'important to set the first row and column of the destination cells 'used in calculation of destination address offsets iFirstDestinationRow = 9 iFirstDestinationColumn = 4 Set ws2 = Worksheets("Sheet2") With Worksheets("Sheet1") aSRCs = .Range("C6:AH197").Value2 End With With ws2 aDSTs = .Cells(iFirstDestinationRow, iFirstDestinationColumn).Resize(UBound(aSRCs, 1), UBound(aSRCs, 2)).Value2 End With For r = LBound(aDSTs, 1) To UBound(aDSTs, 1) For c = LBound(aDSTs, 2) To UBound(aDSTs, 2) If Not CBool(Len(aDSTs(r, c))) Then aDSTs(r, c) = aSRCs(r, c) If rngBLNK Is Nothing Then Set rngBLNK = ws2.Cells(r + (iFirstDestinationRow - 1), c + (iFirstDestinationColumn - 1)) Else Set rngBLNK = Union(rngBLNK, ws2.Cells(r + (iFirstDestinationRow - 1), c + (iFirstDestinationColumn - 1))) End If End If Next c Next r With ws2 .Cells(iFirstDestinationRow, iFirstDestinationColumn).Resize(UBound(aDSTs, 1), UBound(aDSTs, 2)) = aDSTs With rngBLNK .Interior.Color = vbRed .Font.Color = vbWhite End With End With End Sub 

如果目标范围内的单元格是真正的空白，而不是由公式返回的零长度string，那么使用xlCellTypeBlanks使用Range.SpecialCells方法select它们并在将任何值返回给它们之前应用格式化将是一件简单的事情。 但是，这个function限制了8,192个不连续的单元格，并且已经足够接近你的'每页6000单元'了，我不推荐使用它。