|
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 5 And Target.Column <> 10 Then Exit Sub
If Target.Row < 2 Or Target.Row > 51 Then Exit Sub
Dim arr, i, j, k, a, b, cnt
arr = [e2:j52].Value
ReDim brr(1 To UBound(arr, 1), 1 To 1) As Integer
For i = 1 To UBound(arr, 1) - 1
If arr(i, 1) = 1 Then
For j = i To UBound(arr, 1) - 1
If arr(j + 1, 1) <> 1 Then
If j - i + 1 > 2 Then
cnt = 0
For k = i To j
If arr(k, 6) > 0 Then cnt = cnt + 1
Next
If cnt > 2 And cnt < 6 Then
For k = i To j
If arr(k, 6) > 0 Then a = k: Exit For
Next
For k = j To i Step -1
If arr(k, 6) > 0 Then b = k: Exit For
Next
For k = a To b: brr(k, 1) = 5: Next
End If
End If
i = j + 1: Exit For
End If
Next
End If
Next
[n2].Resize(UBound(brr, 1) - 1) = brr
End Sub |
评分
-
2
查看全部评分
-
|