Excel VBA - 为整个单元格范围运行的宏

Question

我在下面的宏代码中执行了一系列单元格的转置。

Sub Macro45()
'
' Macro45 Macro
' r3
'
' Keyboard Shortcut: Ctrl+e
'
Range("F2:G8").Select
Selection.Copy
Range("H2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
End Sub

我想看看如何对整个行范围重复相同的过程。 我的数据集大约有 10000 行，我想在整个范围内执行相同的任务。

Answer 1

看来您采取了 7 行的特定步骤。 所以也许尝试：

Sub Test()

Dim lr As Long, x As Long

With ThisWorkbook.Worksheets("Sheet1") 'Change accordingly

    'Find last used row
    lr = .Cells(.Rows.Count, 6).End(xlUp).Row

    'Step through data and transpose values
    For x = 2 To lr Step 7
        .Cells(x, 8).Resize(2, 7).Value = Application.Transpose(.Range(.Cells(x, 6), .Cells(x + 6, 7)).Value)
    Next x

End With

End Sub

---

或者，如果您真的对复制粘贴值和格式感兴趣：

Sub Test()

Dim lr As Long, x As Long

With ThisWorkbook.Worksheets("Sheet1") 'Change accordingly

    'Find last used row
    lr = .Cells(.Rows.Count, 6).End(xlUp).Row

    'Step through data
    For x = 2 To lr Step 7
        .Range(.Cells(x, 6), .Cells(x + 6, 7)).Copy
        .Cells(x, 8).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Next x

End With

End Sub

Answer 2

这是另一个解决方案：

Sub main()

    Dim rngSrc As Range
    Set rngSrc = Range("F2:G8")

    While (rngSrc.Cells(1, 1).Value2 <> "")
       transpose rngSrc
       Set rngSrc = rngSrc.Offset(7, 0)
    Wend
End Sub


Sub transpose(rngSrc As Range)

    rngSrc.Copy
    rngSrc.Cells(1, 2).Offset(0, 1).PasteSpecial Paste:=xlPasteAll, _
        Operation:=xlNone, SkipBlanks:=False, transpose:=True

End Sub