|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
代码如下。。。
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$P$1" Then
arr = [E13:O681]
ReDim brr(1 To 6, 1 To UBound(arr, 2))
For j = 1 To UBound(arr, 2)
n = 0: m = 7
For i = UBound(arr) To 2 Step -1
n = n + 1
If arr(i, j) = 0 And arr(i - 1, j) <> 0 Then
m = m - 1
If m < 1 Then Exit For Else brr(m, j) = n
n = 0
ElseIf arr(i, j) <> 0 And arr(i - 1, j) = 0 Then
m = m - 1
If m < 1 Then Exit For Else brr(m, j) = n
n = 0
End If
Next
Next
[q7:aa12] = brr
End If
End Sub
|
评分
-
1
查看全部评分
-
|