vba - Excel VBA 复制和转置范围循环
问题描述
我正在尝试将范围内的值从一张表复制和转置到另一张表。
01 02 03 04 05 06 07 08 09 10 11
A B C D E F G H I J K
12 13 14 15 16 17 18 19 20 21 22
L M N O P Q R S T U V
至:
1 A 12 L
2 B 13 M
3 C 14 N
4 D 15 O
5 E 16 P
6 F 17 Q
7 G 18 R
8 H 19 S
9 I 20 T
10 J 21 U
11 K 22 V
所以我想从 4x11 表转到 11x4 表,我有 2212 行数据,这给了我 553 个表进行转置。
我已经有以下代码:
Sub Transpose_Copy_Loop()
Dim CopyRange As Range, OutputCell As Range
Dim r As Long, n As Long, nRows As Integer
n = 5
nRows = 12
For r = 0 To n - 1
Set CopyRange = Worksheets("Sheet6").Range("B1:L4").Offset(r * nRows, 0)
CopyRange.Copy
Set OutputCell = Worksheets("Sheet7").Range("A1").Offset(r * nRows, 0)
OutputCell.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Next
Application.CutCopyMode = False
End Sub
该代码有效,但它只需要每 4 个表并将其转置到另一个表。所以表 1、4、7、10、13、16 等。我似乎找不到原因。任何帮助将不胜感激!
解决方案
由此:
这是转置值:
代码非常灵活:
Sub TestMe()
Dim wks1 As Worksheet: Set wks1 = Worksheets(1)
Dim wks2 As Worksheet: Set wks2 = Worksheets(2)
Dim myVar As Variant
With Application
myVar = .Transpose(wks1.Range("A1:D5"))
End With
Dim loopRows As Long
Dim loopCols As Long
For loopRows = LBound(myVar, 1) To UBound(myVar, 1)
For loopCols = LBound(myVar, 2) To UBound(myVar, 2)
wks2.Cells(loopRows, loopCols) = myVar(loopRows, loopCols)
Next
Next
End Sub
- 代码的想法是将范围内的值写入多维数组 -
myVar = Application.Transpose(wks1.Range("A1:D5"))
- 完成此操作后,循环遍历数组并将值写入相应的行和列即可获得所需的内容。
推荐阅读
- c++ - 编译多个 C++ 文件时出错
- java - “配置数据源失败:未指定‘url’属性,无法配置嵌入式数据源。” springboot应用程序中的错误
- php - Laravel 视频上传 - ios 设备、mime 类型应用程序/八位字节流的问题
- url - 用户事件(子列表 url 字段)
- r - 在 Netlogo 中加载 R 包时遇到问题
- python - 从列中清除字符/str 并使其成为 int 的问题
- python - 列表索引超出范围,我该如何解决?
- python - 在 for 循环中使用 break 和 continue 来遍历字典
- javascript - 按时刻从字符串日期转换为 unix 时间戳
- eclipse - 尝试安装最黑暗的主题后如何在 Ubuntu 上修复 Eclipse?