Question

本质上，此代码从一个工作表中的一个范围中获取一堆值，并将它们粘贴到具有相同范围尺寸的另一个工作表中。但这更像是一种特殊的粘贴，因为此代码仅粘贴到空的单元格中，而不是已经包含另一个工作表上的值的单元格。这是使用变量数组完成的（shoutout到@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 method收集它们，至少可以立即执行实际的格式化操作。

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

如果目标范围中的单元格确实是空白而不是公式返回的零长度字符串，那么使用Range.SpecialCells method xlCellTypeBlanks选择它们并在之前应用格式是一件简单的事情任何值都会返回给他们。然而，这具有8,192个不连续细胞的功能限制，并且足够接近每页的“~6000个细胞”＆＃39;我不建议使用它。

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

1 个答案: