Question

这是我的第一天VBA编码，我正在尝试将多组3个单元格复制到工作表上的另一个位置并转置它们。请查看以下代码以供参考：

Range("A4:A6").Select
Selection.Copy
Range("D1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
Range("A8:A10").Select
Selection.Copy
Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
Range("A12:A14").Select
Selection.Copy
Range("D3").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
Range("A16:A18").Select
Selection.Copy
Range("D4").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
Range("A20:A22").Select
Selection.Copy
Range("D5").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True

所以我想为接下来的200个单元格运行此代码。有什么建议吗？

Answer 1

您不需要Select，甚至Copy / Paste。这会更快：

Dim l As Long
For l = 1 To 200
    With Sheet1
        .Cells(l, "D").Resize(1, 3) = Application.Transpose(.Cells(l * 4, "A").Resize(3, 1))
    End With
Next l

Answer 2

对于StackOverflow中的vba中的每个人来说，这是必读内容：How to avoid using Select in Excel VBA

遵循其规则并使用.Offset()：

Public Sub TestMe()

    Dim cnt As Long
    Dim ws As Worksheet: Set ws = Worksheets(1)

    Dim copiedRange As Range: Set copiedRange = ws.Range("A4:A6")
    Dim targetRange As Range: Set targetRange = ws.Range("D1")

    For cnt = 1 To 20 'or 200
        copiedRange.Copy
        targetRange.PasteSpecial Paste:=xlPasteAll, Transpose:=True

        Set copiedRange = copiedRange.Offset(4)
        Set targetRange = targetRange.Offset(1)

    Next cnt
    Application.CutCopyMode = False

End Sub

MSDN Range.Offset Property

VBA代码将3个单元格的组从一列复制到另一行

2 个答案: