|
楼主 |
发表于 2015-12-7 16:34
|
显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Sub test() 'by kagawa 2015/09/24
ar = [a1].CurrentRegion
m = UBound(ar)
n = UBound(ar, 2)
For i = 2 To m
If ar(i, n) > 0 Then '末位为正时比较简单 从右向左检查即可
For j = n - 1 To 2 Step -1
If ar(i, j) < 0 Then ar(i, j) = ar(i, j + 1) + 1
Next
Else '末位为负时
j1 = 2
Do
For j = j1 To n
If ar(i, j) > 0 Then j2 = j: Exit For '检查到第1个正数时停止
Next
If j > n Then '如检查到末位仍无正数 则从左向右处理
If j1 = 2 Then ar(i, j1) = 1: j1 = 3 '如首位为负数则转为=1开始
For j = j1 To n '从左向右、如>1则减去1、否则=1 直到末位结束
' t = ar(i, j - 1): If t = 1 Then ar(i, j) = 1 Else ar(i, j) = t - 1
ar(i, j) = n - j + 1
Next
Else '如找到正数位置j2
For j = j2 - 1 To j1 Step -1
ar(i, j) = ar(i, j + 1) + 1 '倒序从右到左+1处理
Next
For j = j2 + 1 To n '检查剩余位置中是否有负数
If ar(i, j) < 0 Then j1 = j: Exit For
Next
End If
Loop Until j > n '处理到末位后结束Do循环
End If
Next
[a8].Resize(m, n) = ar '输出结果
End Sub |
|