按数量转置

可乐的乐

ykcbf1100 发表于 2024-1-12 11:01
修改好了。。。

大神如果要空7行或者8行该怎么改，谢谢！！！

ykcbf1100

可乐的乐 发表于 2024-1-12 12:18
大神如果要空7行或者8行该怎么改，谢谢！！！

m=m+7   

可乐的乐

ykcbf1100 发表于 2024-1-12 13:10
m=m+7

第三行变成N/A了

笨鸟飞不高

按数量转置.zip (31.31 KB, 下载次数: 6)

2024-1-12 13:50 上传

点击文件名下载附件

供参考！

可乐的乐

hhlty 发表于 2024-1-12 10:38
Sub t()
    Dim ar, br(1 To 1000, 1 To 24), tr, i
    ar = Sheet1.[a1].CurrentRegion

不好意思我没花了，过几天给你。

ykcbf1100

可乐的乐 发表于 2024-1-12 12:18
大神如果要空7行或者8行该怎么改，谢谢！！！

间隔7行。。。

可乐的乐

ykcbf1100 发表于 2024-1-12 14:30
间隔7行。。。

谢谢大神，可以了

cjc209

function test(){
        var arr=maxArray_Z("Sheet1!a1:d1");
        var arr1=少列转多列_限定列数(arr,5,1,"c",0)
                arr1.insertRows_Z("f1-f"+(arr1.length-1),"",4).toRange_Z("Sheet2!a5")
}

gwjkkkkk

Option Explicit
Sub TEST1()
    Dim ar, br, i&
    Application.ScreenUpdating = False
    With [A1].CurrentRegion
        ReDim ar(1 To .Rows.Count)
        For i = 1 To UBound(ar)
            Set ar(i) = .Rows(i)
        Next i
    End With
    br = arrLocated(UBound(ar), 5, 5, 5)
    With [F1]
        For i = 1 To UBound(ar)
            ar(i).Copy .Cells(br(i, 1), br(i, 2))
        Next i
    End With
    Application.ScreenUpdating = True
    Beep
End Sub
Function arrLocated(ByVal iCount&, ByVal iColNum&, ByVal iStepRows&, ByVal iStepColumns&)
    Dim ar, i&, n&, y&, x&
    ReDim ar(1 To iCount, 1 To 2)
    For i = 1 To UBound(ar)
        n = IIf(i Mod iColNum = 0, iColNum, i Mod iColNum)
        y = (-Int(-(i / iColNum)) - 1) * iStepRows + 1
        x = (n - 1) * iStepColumns + 1
        ar(i, 1) = y: ar(i, 2) = x
    Next i
    arrLocated = ar
End Function

gwjkkkkk

参与一下。。。