Excel代码问题，非常感谢！

LSYYLW

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

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

quqiyuan

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

这样改才可以，仅供参考。。。。

quqiyuan

代码如下，，，
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Address = "$N$1" Then
        arr = [h21:h220]
        ReDim brr(1 To UBound(arr), 0)
        For i = 1 To UBound(arr)
            If arr(i, 1) > 1 Then arr(i, 1) = 2
            s = s & arr(i, 1)
        Next
        For m = 1 To UBound(arr)
            i = InStr(m, s, "2")
            x = InStr(i, s, "0")
            y = InStr(i, s, "1")
            Z = Application.Min(x, y)
            If y > 0 Then ii = InStr(y, s, "2")
            If ii > y And y <> 0 Then
                ss = Mid(s, i, y - i + 1)
                zZ = InStrRev(ss, "2")
                j = j + 1
                brr(j, 0) = zZ
                j = j + 1
                brr(j, 0) = ii - zZ - i
                m = ii - 1
            ElseIf ii = 0 And y > 0 Then
                ss = Mid(s, i, y - i + 1)
                zZ = InStrRev(ss, "2")
                j = j + 1
                brr(j, 0) = zZ
                j = j + 1
                brr(j, 0) = 201 - zZ - i
                m = 200
            End If
            If y = 0 Then
                j = j + 1
                brr(j, 0) = 201 - i
                m = 200
            End If
        Next
        With Sheet3
            .Range(.[n78], .[n78].End(3)).ClearContents
            .[n78].Offset(-j + 1).Resize(j) = brr
        End With
    End If
    Application.EnableEvents = True
End Sub
   

LSYYLW

quqiyuan 发表于 2024-12-10 17:41
这样改才可以，仅供参考。。。。

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