如何在 Excel VBA 中使用单元格偏移重复代码

Question

提前为简单的问题道歉。 我是 VBA 的新手。

我在excel中有以下示例数据：

我想复制点 1 到 5 的 X、Y 和 Z 值，并将它们与值 30、40、50...等值放在同一行中。 我编写了以下代码，它复制了 30 旁边的一组点 1-5，如何将其再次应用于 40、50...等。 我的整个数据集远远超过 50 个，因此自动化是关键。

Sub MoveCopyCells()

Range(Cells(26, 2), Cells(26, 4)).Copy Range(Cells(24, 2), Cells(24, 4))
Range(Cells(27, 2), Cells(27, 4)).Copy Range(Cells(24, 11), Cells(24, 13))
Range(Cells(28, 2), Cells(28, 4)).Copy Range(Cells(24, 14), Cells(24, 16))
Range(Cells(29, 2), Cells(29, 4)).Copy Range(Cells(24, 17), Cells(24, 19))
Range(Cells(30, 2), Cells(30, 4)).Copy Range(Cells(24, 26), Cells(24, 28))

End Sub

Answer 1

您可以通过使用.Resize()函数将引用范围从单个单元格扩展到表格（多行和多列）来复制多个值。

源单元格也很好地按行排列，但目标单元格不是。 因此，目标列偏移量可以存储在数组中以供循环使用。

Sub BetterCopyCells()

    Dim col_offset() As Variant, i As Long
    col_offset = Array(0, 9, 12, 15, 24)

    For i = 0 To 4
        Range("B24").Offset(0, col_offset(i)).Resize(1, 3).Value2 = _
            Range("B26").Offset(i, 0).Resize(1, 3).Value2
    Next i

End Sub

一般的流程是这样的

Range("Top Left of Destination").Resize(noRows,noCols).Value2 = _
    Range("Top Left of Source").Resize(noRows,noCols).Value2

您可以使用.Cells()或.Offset()从绝对引用（如Range("B2")到相对位置。 以下两个参考具有完全相同的结果

Range("B2").Cells(10,3)  ' => points to "D11"
Range("B2").Offset(9,2)  ' => points to "D11"

Answer 2

有一些限制，但切换到数组更快。

Sub test()
    Dim rng As Range
    Dim r As Long, i As Long
    Dim vR As Variant
    r = Range("a" & Rows.Count).End(xlUp).Row

    For i = 1 To r Step 8
        Set rng = Range("a" & i)
        vR = TransData(rng)
        rng.Offset(, 1).Resize(1, 27) = vR
    Next i

End Sub
Function TransData(rng As Range) As Variant
    Dim vDB, vR(1 To 27)
    Dim i As Integer, j As Integer
    Dim c As Variant

    c = Array(1, 10, 13, 16, 25)

    vDB = rng.Offset(2, 1).Resize(5, 3)
    For i = 0 To 4
        For j = 1 To 3
            vR(c(i) + j - 1) = vDB(i + 1, j)
        Next j
    Next i
    TransData = vR
End Function