在特殊条件下将一系列细胞粘贴到相同大小的目标范围内?

时间:2016-01-07 21:34:17

标签: excel vba range conditional-statements copy-paste

感谢您帮助我。我无法在网上找到解决方案,所以这里是am:P。我想知道如何将一系列值(在本例中为C6:R371)粘贴到相同大小的另一个工作表中。我的问题是我只想将源工作表中的数据粘贴到目标工作表上为空白的单元格中,而不是更改目标工作表上C6:R371范围内已有的值。基本上,我有一系列需要c& p的单元格,但我希望宏只将该范围内的值粘贴到目标范围的空白单元格上。非常感谢你

    Range("C6:S371").Select
    Selection.Copy
    wbWest2.Activate
    Dim rng As Range 
    Dim row As Range 
    Dim cell As Range 
    Set rng = Range("D9:S374") 
    For Each row In rng.Rows 
    For Each cell in row.Cells 
    If cell.value = 0 then selection.paste 
    Next cell 
    Next row         

1 个答案:

答案 0 :(得分:1)

使用With ... End With statements隔离两个工作表,这样才能考虑其中的单元格。最快的比较是将两个范围批量加载到变体数组中。

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 Not CBool(Len(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

一旦满足比较并且目标中的空白值填充了源中的值,整个变量数组将返回到目标工作表。

范围始终保持相同的大小。将源值加载到第一个变体数组后,LBoundUBound函数将用于从左上角的单元格扩展的目标范围的所有进一步标注。