Excel代码问题，非常感谢！

quqiyuan

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

quqiyuan

代码如下，，，
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Address = "$K$1" Then
        arr = [d8:d97]
        [d97] = 1
        ReDim brr(1 To UBound(arr), 0) As Long
        For i = 1 To UBound(arr)
            n = 0
            For j = i To UBound(arr)
                If arr(j, 1) = 0 Then
                    n = n + 1
                Else
                    n = n + 1
                    brr(j, 0) = n
                    i = j
                    Exit For
                End If
            Next
        Next
        [k8].Resize(UBound(brr)) = brr
        Beep
    End If
    Application.EnableEvents = True
End Sub
   

LSYYLW

2025-4-9-.zip (2.85 KB, 下载次数: 3)

2025-4-9 16:50 上传

点击文件名下载附件

LSYYLW

quqiyuan 发表于 2025-4-9 16:31
参与一下，仅供参考。。。

万万分的感谢老师，代码非常非常好用，您完美的为我解决了问题。非常抱歉，今天还得麻烦老师您一下，您有时间帮我看一下23楼附件里的问题，拜托您了！

quqiyuan

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

quqiyuan

代码如下。。。
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Address = "$E$1" Then
        arr = [e8:e97]
        ReDim crr(1 To UBound(arr), 0)
        For i = 1 To UBound(arr)
            If arr(i, 1) <> 0 Then
                n = n + 1
                crr(n, 0) = arr(i, 1)
            End If
        Next
        [j97].Offset(1 - n).Resize(n) = crr
        Beep
    End If
    Application.EnableEvents = True
End Sub
   

LSYYLW

2025-4-10.zip (13.82 KB, 下载次数: 3)

2025-4-9 21:09 上传

点击文件名下载附件

LSYYLW

quqiyuan 发表于 2025-4-9 19:08
参与一下，仅供参考。。。

再次万万分的感谢老师，代码非常非常好用，您完美的为我解决了问题。非常抱歉，今天还得麻烦老师您一下，您有时间帮我看一下27楼附件里有颜色单元格里的文字，帮我解决一下，拜托您了！

quqiyuan

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

quqiyuan

代码如下。。。
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Address = "$E$1" Then
        arr = [e8:f97]
        For j = 1 To 2
            n = 0
            ReDim crr(1 To UBound(arr), 0)
            For i = 1 To UBound(arr)
                If arr(i, j) <> 0 Then
                    n = n + 1
                    crr(n, 0) = arr(i, j)
                End If
            Next
            [j97].Offset(1 - n, j - 1).Resize(n) = crr
        Next
        Beep
    End If
    Application.EnableEvents = True
End Sub