Question

感谢您抽出宝贵的时间阅读我的帖子。我试图编写我的第一个VBA宏，并使自己对下一步的工作感到困惑。我在网上发现了几段代码，这些代码是我凑在一起的，它们在循环的第一轮中工作得很好，但是在随后的循环中没有执行预期的任务。

我的目标是将数千个单元格的数据从单个列复制并转置到新位置，一次22个单元格。因此，我的循环旨在复制H2：H23，然后向下移动并复制H24：H46，依此类推。每次它转置并将数据粘贴到新位置时，其位置都比最近粘贴的位置低一个单元格。现在，按它的方式运行时，我发现代码制作了一个副本，并且看到它选择了下一个范围，但是我不知道如何使它记住该范围并继续转置其余行。

如果您能弄清楚如何完成这项工作，我将不胜感激！

Sub TranspositionLoop()

Dim SourceRange As Range
Dim DestRange As Range

Set SourceRange = Application.InputBox(Prompt:="Please select the range to transpose", Title:="Transpose Rows to Columns", Type:=8)
Set DestRange = Application.InputBox(Prompt:="Select the upper left cell of the destination range", Title:="Transpose Rows to Columns", Type:=8)

For x = 1 To 257

SourceRange.Select
SourceRange.Copy
DestRange.Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False

SourceRange.Offset(23, 0).Select
DestRange.Offset(1, 0).Select

Next x

End Sub

Answer 1

我知道了。

Sub TranspositionLoop()

Dim SourceRange As Range
Dim DestRange As Range
Dim x As Integer

Set SourceRange = Application.InputBox(Prompt:="Please select the range to transpose", Title:="Transpose Rows to Columns", Type:=8)
Set DestRange = Application.InputBox(Prompt:="Select the upper left cell of the destination range", Title:="Transpose Rows to Columns", Type:=8)

For x = 1 To 5

SourceRange.Select
SourceRange.Copy
DestRange.Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False

Set SourceRange = SourceRange.Offset(22, 0)
Set DestRange = DestRange.Offset(1, 0)

Next x

End Sub

VBA转置循环源问题

1 个答案: