excel - 从非连续单元格复制数据

Question

我想自动将数据从一个非连续范围复制到另一个范围。源和目标具有相同数量的单元格，但范围形状不同。下面是一个简化的图形来演示。

数据的简化：

源数据位于单个列中，并且不连续。目标范围是将存储的数据复制到仪表板的位置。

所有建议表示赞赏。

标签： excelvba

Answer 1

将非连续范围复制到另一个非连续范围

• 调整常量部分中的值。

Option Explicit

Sub CopyNonContiguous()
    
    ' Constants
    
    ' Source
    Const sName As String = "Sheet1"
    Const sAddress As String = "G3:G6,G8:G15"
    ' Destination
    Const dName As String = "Sheet1"
    Const dAddress As String = "B3:B4,B6:B7,B9:E10"
    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Destination Range
    
    Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
    Dim drg As Range: Set drg = dws.Range(dAddress)
    'drg.Interior.Color = 14348258 ' green
    
    ' Source Range
    
    Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
    Dim srg As Range: Set srg = sws.Range(sAddress)
    'srg.Interior.Color = 13431551 ' yellow
    
    ' Source Data Array
    
    Dim scCount As Long: scCount = srg.Cells.Count
    Dim sData As Variant: ReDim sData(1 To scCount)
    
    ' Additional Variables
    
    Dim arg As Range ' Current Range Area
    Dim cel As Range ' Current Cell in Current Range Area
    Dim n As Long ' Source Data Array Elements Counter
    
    ' Source Range to Source Data Array
    
    For Each arg In srg.Areas
        For Each cel In arg.Cells
            n = n + 1
            'cel.Value = n ' to populate the Source Range
            sData(n) = cel.Value
        Next cel
    Next arg
    
    ' Source Data Array to Destination Range
    
    ' Reset 'n' because at this moment 'n = scCount'.
    n = 0
    For Each arg In drg.Areas
        For Each cel In arg.Cells
            n = n + 1
            cel.Value = sData(n)
            ' Since the Destination Range could contain more cells than
            ' the Source Range, test with the following:
            If n = scCount Then Exit Sub
        Next cel
    Next arg
    
End Sub