Excel代码问题，非常感谢!

LSYYLW

2024-11-19---.zip (11.16 KB, 下载次数: 6)

2024-11-19 07:31 上传

点击文件名下载附件

xlj310

你这题 并不难呀，我看你是不是问过很多回貌似没有人答，是什么原因呢？

quqiyuan

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

quqiyuan

代码如下。。。
   
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Address = "$BS$1" Then
        arr = [bo58:bo474]
        ReDim brr(1 To 37, 0)
        For i = UBound(arr) To 2 Step -1
            If arr(i, 1) = arr(i - 1, 1) Then arr(i, 1) = 0
        Next
        n = 38
        For i = UBound(arr) To 1 Step -1
            If arr(i, 1) <> 0 Then n = n - 1: brr(n, 0) = arr(i, 1)
            If n = 1 Then Exit For
        Next
        [bs2].Resize(37) = brr
        Beep
    End If
    Application.EnableEvents = True
End Sub
   

quqiyuan

又审核，重新发个附件吧。。。。

LSYYLW

quqiyuan 发表于 2024-11-19 12:58
又审核，重新发个附件吧。。。。

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

LSYYLW

2024-11-21.zip (2.87 KB, 下载次数: 2)

2024-11-19 19:37 上传

点击文件名下载附件

LSYYLW

quqiyuan 发表于 2024-11-19 12:58
又审核，重新发个附件吧。。。。

老师您好：今天又来麻烦您了，您在有时间的时候帮我看一下7楼附件里的问题，拜托您了！

quqiyuan

LSYYLW 发表于 2024-11-19 19:41
老师您好：今天又来麻烦您了，您在有时间的时候帮我看一下7楼附件里的问题，拜托您了！

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

quqiyuan

代码如下。。。。
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Address = "$M$1" Then
        arr = [e3:e102]
        m = 0: n = 0
        For i = UBound(arr) To 2 Step -1
            If arr(i, 1) > 1 Then arr(i, 1) = 2
        Next
        For i = 1 To UBound(arr)
            If arr(i, 1) <> Empty Then s = s & arr(i, 1): m = m + 1
        Next
        ReDim brr(1 To UBound(arr), 0)
        For i = 1 To Len(s)
            x = InStr(i, s, "1")
            y = InStr(i, s, "2")
            If x > y And y > 0 Or x < y And x > 0 Then
                n = n + 1
                brr(n, 0) = Abs(x - y)
                i = Application.Max(x, y) - 1
            ElseIf x > 0 And y = 0 Or y > 0 And x = 0 Then
                n = n + 1
                brr(n, 0) = m - Application.Max(x, y) + 1
                i = UBound(arr)
            End If
        Next
        Cells(100 - n + 1, "m").Resize(n) = brr
        Beep
    End If
    Application.EnableEvents = True
End Sub