|
|
代码如下。。。。
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Address = "$K$1" Then
arr = [e211:e850]
For i = UBound(arr) To 2 Step -1
If arr(i, 1) > 1 Then arr(i, 1) = 2
Next
For i = UBound(arr) To 2 Step -1
If arr(i, 1) > 0 And arr(i, 1) = arr(i - 1, 1) Then arr(i, 1) = 0
Next
s = Join(Application.Transpose(arr), "")
ReDim brr(1 To 1000)
For i = 1 To UBound(arr)
x = InStr(i, s, "1")
y = InStr(i, s, "2")
If x < y And x > 0 Then
cnt = 0
For j = x To y - 1
If arr(j, 1) > 0 Then cnt = cnt + 1
Next
n = n + 1
brr(n) = cnt
i = y - 1
ElseIf x > y And y > 0 Then
cnt = 0
For j = y To x - 1
If arr(j, 1) > 0 Then cnt = cnt + 1
Next
n = n + 1
brr(n) = cnt
i = x - 1
ElseIf x < y And x = 0 Or x > y And y = 0 Then
cnt = 0
For j = Application.Max(x, y) To UBound(arr)
If arr(j, 1) > 0 Then cnt = cnt + 1
Next
n = n + 1
brr(n) = cnt
i = UBound(arr)
End If
Next
Cells(300 - n + 1, "k").Resize(n) = Application.Transpose(brr)
Beep
End If
Application.EnableEvents = True
End Sub
|
评分
-
2
查看全部评分
-
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2024-11-17 08:55
楼主
