[已解决]不知哪位高手老师能为我写一个遇0加1遇1减1的ＶＢＡ统计表格

pqp888

求一个遇0加1遇1减1的ＶＢＡ统计表格，要求见附件。

最佳答案

月排行榜 / 总排行榜

grf1973

2016-1-20 11:21

1. Sub 遇0加1遇1减1()
   
2.     rmax = Cells(65536, 3).End(3).Row + 1
   
3.     cmax = ActiveSheet.UsedRange.Columns.Count    '最大列
   
4.     arr = Range([c5], Cells(rmax, cmax))
   
5.     For i = 1 To UBound(arr) - 1 Step 2
   
6.         S = Val(arr(i + 1, UBound(arr, 2)))
   
7.         For j = 1 To UBound(arr, 2) - 1        '清空答案区（保留自设起点值）
   
8.             arr(i + 1, j) = ""
   
9.         Next
   
10.         For j = UBound(arr, 2) - 1 To 1 Step -1
    
11.             x = arr(i, j)
    
12.             If x = 0 Then
    
13.                 S = S + 1
    
14.                 arr(i + 1, j) = S
    
15.             ElseIf x = 1 Then
    
16.                 S = IIf(S > 1, S - 1, 0)
    
17.                 arr(i + 1, j) = S
    
18.             End If
    
19.         Next
    
20.     Next
    
21.     [c5].Resize(UBound(arr), UBound(arr, 2)) = arr
    
22. End Sub

复制代码

跳转到最佳答案楼层

grf1973

1. Sub 遇0加1遇1减1()
   
2.     rmax = Cells(65536, 3).End(3).Row + 1
   
3.     cmax = ActiveSheet.UsedRange.Columns.Count    '最大列
   
4.     arr = Range([c5], Cells(rmax, cmax))
   
5.     For i = 1 To UBound(arr) - 1 Step 2
   
6.         S = Val(arr(i + 1, UBound(arr, 2)))
   
7.         For j = 1 To UBound(arr, 2) - 1        '清空答案区（保留自设起点值）
   
8.             arr(i + 1, j) = ""
   
9.         Next
   
10.         For j = UBound(arr, 2) - 1 To 1 Step -1
    
11.             x = arr(i, j)
    
12.             If x = 0 Then
    
13.                 S = S + 1
    
14.                 arr(i + 1, j) = S
    
15.             ElseIf x = 1 Then
    
16.                 S = IIf(S > 1, S - 1, 0)
    
17.                 arr(i + 1, j) = S
    
18.             End If
    
19.         Next
    
20.     Next
    
21.     [c5].Resize(UBound(arr), UBound(arr, 2)) = arr
    
22. End Sub

复制代码

pqp888

grf1973 发表于 2016-1-20 11:21

谢谢老师