Excel代码问题，非常感谢!

quqiyuan

现在审核蛮频繁的，，，，

LSYYLW

quqiyuan 发表于 2024-11-19 20:27
现在审核蛮频繁的，，，，

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

quqiyuan

更新了一下

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(2, "m").Resize(99).ClearContents
        Cells(100 - n + 1, "m").Resize(n) = brr
        Beep
    End If
    Application.EnableEvents = True
End Sub
   
   

LSYYLW

quqiyuan 发表于 2024-11-19 21:44
更新了一下

再次感谢老师，问题完美解决了，让您受累了。