Excel代码问题，非常感谢！

LSYYLW

quqiyuan 发表于 2024-10-18 17:01
你删除我标亮的那一句

老师您好：又来麻烦您了，您有时间帮我看一下20楼附件里有颜色的文字，帮我解决一下，拜托您了！

quqiyuan

LSYYLW 发表于 2024-10-21 08:03
老师您好：又来麻烦您了，您有时间帮我看一下20楼附件里有颜色的文字，帮我解决一下，拜托您了！

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

quqiyuan

代码如下。。。
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Address = "$H$1" Then
        arr = [b3:b34]
        ReDim brr(1 To UBound(arr) - 9, 1 To 1)
        m = 0
        For i = 10 To UBound(arr)
            If arr(i, 1) <> 0 Then
                n = 0
                For j = i - 10 + 1 To i
                    If arr(j, 1) <> 0 Then n = n + 1
                Next
                m = m + 1
                brr(m, 1) = n
            Else
                m = m + 1
                brr(m, 1) = "#N/A"
            End If
        Next
        [h12].Resize(UBound(brr)) = brr
    End If
    Application.EnableEvents = True
End Sub

LSYYLW

quqiyuan 发表于 2024-10-21 13:12
代码如下。。。
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents =  ...

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