用vba把行转成列

bbm000000

fxl447098457 发表于 2017-12-5 09:47
看了下，楼主是要得到Sheet2的结果，你好像反过来了。。

晕，看反了
Sub ii()
Dim i, ar, br(1 To 65536, 1 To 6)
ar = [a1].CurrentRegion
For i = 2 To UBound(ar, 1)
k = k + 1
For i1 = 1 To 6
br(k, i1) = ar(i, i1)
Next
For i2 = 7 To UBound(ar, 2) Step 3
If ar(i, i2) = "" Then Exit For
k = k + 1
br(k, 2) = ar(i, i2)
br(k, 3) = ar(i, i2 + 1)
br(k, 4) = ar(i, i2 + 2)
Next
Next
[a21].Resize(k, 6) = br
End Sub

LMY123

三维转二维，二维转三维

yufan427

ahnyt 发表于 2017-12-5 08:55
你的源文件的列是固定的还是不固定的

源文件列是固定的，数据量在1万左右。

yufan427

谢谢各位老师。非常感谢！

gerogeedward

谢谢你了，好开行

h2016

家庭人员信息转化

chxw68

凑凑热闹练练手。

h2016

户主问题留着学习

ykcbf1100

练练手。。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.3.21
   
2.     arr = Sheets("Sheet1").UsedRange
   
3.     ReDim brr(1 To UBound(arr) * 10, 1 To 6)
   
4.     For i = 2 To UBound(arr)
   
5.         m = m + 1
   
6.         For j = 1 To 6
   
7.             brr(m, j) = arr(i, j)
   
8.         Next
   
9.         For j = 7 To UBound(arr, 2) Step 3
   
10.             If arr(i, j) <> Empty Then
    
11.                 m = m + 1
    
12.                 brr(m, 2) = arr(i, j)
    
13.                 brr(m, 3) = arr(i, j + 1)
    
14.                 brr(m, 4) = arr(i, j + 2)
    
15.                 brr(m, 5) = brr(m - 1, 5)
    
16.                 brr(m, 6) = brr(m - 1, 6)
    
17.             End If
    
18.         Next
    
19.     Next
    
20.     With Sheets("Sheet2")
    
21.         .UsedRange.Offset(1) = ""
    
22.         .[a2].Resize(m, 6) = brr
    
23.     End With
    
24.     MsgBox "OK！"
    
25. End Sub
    

复制代码