特殊的转置合并操作

天地一相

感谢帮助！详见截图附件。

笨鸟飞不高

特殊转制.zip (14.14 KB, 下载次数: 9)

2023-5-29 14:23 上传

点击文件名下载附件

不知道为什么

如图，参考。。。

笨鸟飞不高

Sub AwTest()
    Dim i&, c%, eRow&, k%, r&, Sr$, arr
    c = Range("J1").Value
    If c = 0 Or c > 9 Then Exit Sub
    eRow = Cells(Rows.Count, c).End(3).Row
    If eRow = 1 Then eRow = eRow + 1
    arr = Cells(1, c).Resize(eRow)
    ReDim brr(1 To eRow, 1 To 1)
    For i = eRow To 1 Step -1
        If Len(arr(i, 1)) Then
            r = i: k = 0
            Do
                If r > 0 Then Sr = arr(r, 1)
                k = k + 1
                brr(i, 1) = IIf(brr(i, 1) = "", Sr, brr(i, 1) & Sr)
                r = r - 1
            Loop Until k = 3
        End If
    Next
    Columns("M:M").ClearContents
    Range("M1").Resize(eRow) = brr
End Sub

换一种写法！

笨鸟飞不高

特殊转制.zip (18.79 KB, 下载次数: 6)

2023-5-29 14:48 上传

点击文件名下载附件

换一种写法！！

zxsea_7426

ykcbf1100

参与一下。

gwjkkkkk

参与一下。。。

cyq4896

特殊的转置