Excel代码问题，非常感谢！

LSYYLW

2024-11-24.zip (6.86 KB, 下载次数: 3)

2024-11-24 14:47 上传

点击文件名下载附件

quqiyuan

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

quqiyuan

代码如下。。。
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Address = "$AA$1" Then
        arr = [ab23:ak81]
        ReDim brr(1 To UBound(arr) - 1, 0)
        For i = 2 To UBound(arr)
            x = Application.Match(0, Application.Index(arr, i), 0)
            brr(i - 1, 0) = comp(Application.Index(arr, i - 1), arr(i - 1, x))
        Next
        [av24].Resize(UBound(brr)) = brr
        Beep
    End If
    Application.EnableEvents = True
End Sub

Function comp(x, y)
    For Each s In x
        If s < y Then n = n + 1
    Next
    comp = n + 1
End Function
   

LSYYLW

quqiyuan 发表于 2024-11-24 15:29
参与一下，仅供参考。。。

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

LSYYLW

2024-12-14.zip (18.33 KB, 下载次数: 3)

2024-12-14 08:08 上传

点击文件名下载附件

chxw68

答案在I列。

chxw68

详见附件。

quqiyuan

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

quqiyuan

代码如下。。。。
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Address = "$H$1" Then
        arr = [e51:e335]
        arr(UBound(arr), 1) = 0
        crr = arr
        ReDim brr(1 To UBound(arr), 0)
        For i = 1 To UBound(arr)
            If arr(i, 1) > 0 Then
                arr(i, 1) = 1
            Else
                arr(i, 1) = 0
            End If
            s = s & CStr(arr(i, 1))
            brr(i, 0) = 0
        Next
        For i = 1 To Len(s)
            x = InStr(i, s, "000")
            If IsNumeric(x) And x <> 0 Then
                brr(x + 2, 0) = 100
                i = x
            Else
                Exit For
            End If
        Next
        For i = 2 To UBound(crr)
            If crr(i, 1) = 0 Then
                If crr(i - 1, 1) <> 0 Then
                    For j = i - 1 To 2 Step -1
                        If crr(j, 1) = 0 Then
                            If crr(j - 1, 1) <> 0 And crr(j - 1, 1) = crr(i - 1, 1) Then
                                brr(i, 0) = crr(i - 1, 1)
                                Exit For
                            Else
                                Exit For
                            End If
                        End If
                    Next
                End If
            End If
        Next
        [h51].Resize(UBound(brr)) = brr
        Beep
    End If
    Application.EnableEvents = True
End Sub
   

LSYYLW

chxw68 发表于 2024-12-14 08:56
答案在I列。

非常感谢老师，代码非常好用，鲜花稍后为您献上。