怎么把A列的数据，按固定行数转置

xuvslove

怎么把A列的数据，按固定行数转置，A列数据每4行就在D列转置，能批量操作吗，请大神帮忙，上传附件

3190496160

Sub 转置()
Dim ar As Variant
Dim arr()
With Sheets("sheet1")
    r = .Cells(Rows.Count, 1).End(xlUp).Row
    ar = .Range("a1:a" & r)
    .Range("d1:g" & r) = Empty
    ReDim arr(1 To UBound(ar), 1 To 4)
    n = 1
    For i = 1 To UBound(ar) Step 4
        m = 0
        For s = i To i + 3
            If s <= UBound(ar) Then
                m = m + 1
                arr(n, m) = ar(s, 1)
            End If
        Next s
        n = n + 4
    Next i
    .[d1].Resize(n, 4) = arr
End With
MsgBox "ok!"
End Sub

3190496160

模板1.rar (26.25 KB, 下载次数: 7)

2022-6-12 08:46 上传

点击文件名下载附件

minchar

选中D2到G2
D2=IF(MOD(ROW(),4)=1,TRANSPOSE(OFFSET(A1,,,4,)),"")
三键下拉

xuvslove

3190496160 发表于 2022-6-12 08:46
Sub 转置()
Dim ar As Variant
Dim arr()

感谢大神

xuvslove

3190496160 发表于 2022-6-12 08:46
Sub 转置()
Dim ar As Variant
Dim arr()

可不可以自动执行，我复制进A列的数据,在D列自动执行生成

3190496160

xuvslove 发表于 2022-6-14 15:28
可不可以自动执行，我复制进A列的数据,在D列自动执行生成

点一下按钮很费劲吗？？？？？？？？？？？？？？？？？？

xuvslove

3190496160 发表于 2022-6-14 15:35
点一下按钮很费劲吗？？？？？？？？？？？？？？？？？？

我是批量复制，能自动省事点

3190496160

xuvslove 发表于 2022-6-14 16:06
我是批量复制，能自动省事点

不是不可以，论坛是做义务的，没有人愿意在一个问题上反复折腾的，所以，一开始就要把自己的真是意图表述清楚

xuvslove

3190496160 发表于 2022-6-14 16:09
不是不可以，论坛是做义务的，没有人愿意在一个问题上反复折腾的，所以，一开始就要把自己的真是意图表述 ...

好的吧，尊重大神，还是表示感谢