Excel代码问题，非常感谢！

LSYYLW

2024-9-8.zip (16.09 KB, 下载次数: 6)

2024-9-7 20:44 上传

点击文件名下载附件

饮冰e士

很好奇，玩出这么多花样的文件，最终会是一个什么样的东东？

quqiyuan

参与一下，仅供参考。。。

quqiyuan

代码如下。。。
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address <> "$BF$1" Then Exit Sub
    Application.ScreenUpdating = False
    arr = [bf182:bf821]
    brr = [bi1:bm1]
    ReDim crr(1 To UBound(arr), 1 To UBound(brr, 2))
    ReDim drr(1 To UBound(brr, 2))
    For i = 1 To UBound(brr, 2)
        n = 0
        For j = UBound(arr) - brr(1, i) + 1 To 1 Step -brr(1, i)
            n = n + 1
            crr(n, i) = arr(j, 1)
        Next
        drr(i) = n
        x = Application.Max(x, n)
    Next
    ReDim frr(1 To x, 1 To UBound(brr, 2))
    For Each m In drr
        n = 0: k = k + 1
        For i = x To 1 Step -1
            n = n + 1
            frr(n, k) = crr(i, k)
        Next
    Next
    Cells(2, "bi").Resize(641, UBound(brr, 2)).ClearContents
    Cells(642 - x + 1, "bi").Resize(x, UBound(frr, 2)) = frr
    Beep
    Application.ScreenUpdating = True
End Sub

LSYYLW

quqiyuan 发表于 2024-9-7 22:47
代码如下。。。
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address  "$BF$1"  ...

万分的感谢老师，代码非常好用。

jaxxcyh

饮冰e士 发表于 2024-9-7 21:53
很好奇，玩出这么多花样的文件，最终会是一个什么样的东东？

感觉跟博彩有关，对这种莫名其妙的需求，俺一般都远离