[已解决]难题：请问用vba的for循环能否得到F列的结果

qhllqhll

请问用vba的数组 for循环能否得到F列的结果
请看附件：谢谢各位赐教
附件.rar (3.87 KB, 下载次数: 22)

2012-12-10 09:46 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2012-12-11 09:34

1. Sub 求和3()
   
2.     Dim arr, i&
   
3.     Dim iSum&                            '求和
   
4.     Dim startRow&                        '开始行标记
   
5.    
   
6.     i = Range("d" & Rows.Count).End(xlUp).Row   '取D列最后一行数据行行号
   
7.     arr = Range("c3:f" & i) '.CurrentRegion     '取C3区域
   
8.     For i = LBound(arr) + 1 To UBound(arr)
   
9.         '如果有单元格为空，则跳过计算过程
   
10.         If Len(arr(i, 2)) = 0 Or Len(arr(i, 3)) = 0 Then GoTo 0
    
11.         If Len(arr(i, 1)) > 0 Then  '如果C列单元格不为空，则标志着一轮求和开始
    
12.             startRow = i            '要写入求和的行号（此处是数组，则是数组的一维坐标）
    
13.         End If
    
14.         iSum = iSum + Abs(arr(i, 2) - arr(i, 3))    '累加求和，D列减去E列，取绝对值
    
15.         If i = UBound(arr) Then arr(startRow, 4) = iSum: Exit For
    
16.         '如果到达数据最后一行则写入累加数据，退出循环
    
17.         
    
18.         '判断下一行是否有数据标志，如果有，则此轮求和结束
    
19.         If Len(arr(i + 1, 1)) > 0 Then
    
20.             arr(startRow, 4) = iSum     '写入求和
    
21.             iSum = 0                    '清零
    
22.             startRow = 0                '清零
    
23.         End If
    
24. 0:
    
25.     Next
    
26.     Range("c3").Resize(UBound(arr), UBound(arr, 2)) = arr
    
27.     '把计算好的数据回写入单元格
    
28. End Sub

复制代码

跳转到最佳答案楼层

风化石

附件.rar (9.83 KB, 下载次数: 5)

2012-12-10 10:47 上传

点击文件名下载附件

hwc2ycy

1. Sub 求和()
   
2.     Dim arr, i
   
3. 
   
4.     arr = Range("c3").CurrentRegion
   
5.     Dim irow
   
6.     Dim iSum
   
7.     Dim startRow
   
8.     For i = LBound(arr) + 1 To UBound(arr)
   
9.         If Len(arr(i, 1)) > 0 Then
   
10.             startRow = i
    
11.         End If
    
12.         iSum = iSum + Abs(arr(i, 2) - arr(i, 3))
    
13.         If i = UBound(arr) Then arr(startRow, 4) = iSum: Exit For
    
14.         If Len(arr(i + 1, 1)) > 0 Then
    
15.             arr(startRow, 4) = iSum
    
16.             iSum = 0
    
17.             startRow = 0
    
18.         End If
    
19.     Next
    
20.     Range("c3").Resize(UBound(arr), UBound(arr, 2)) = arr
    
21. End Sub
    

复制代码

qhllqhll

首先感谢两位的辛勤赐教：经测试 当e20：e23为空时 3楼的代码在空行区后面的计算有误，还请各位老师抽空帮我看看有没有更简便的代码，最好在每句代码的后面加上注释
见附件
谢谢
附件2.rar (9.93 KB, 下载次数: 7)

2012-12-10 17:18 上传

点击文件名下载附件

qhllqhll

风化石 发表于 2012-12-10 10:47

非常感谢您的赐教：
不好意思：还有点小问题
见4楼附件

qhllqhll

hwc2ycy 发表于 2012-12-10 10:55

非常感谢您的赐教：
不好意思：还有点小问题
见4楼附件

hwc2ycy

那两行空单元格，你要求结果等于多少？

hwc2ycy

1. Sub 求和()
   
2.     Dim arr, i
   
3.     arr = Range("c3").CurrentRegion
   
4.     Dim irow
   
5.     Dim iSum
   
6.     Dim startRow
   
7.     For i = LBound(arr) + 1 To UBound(arr)
   
8.         If Len(arr(i, 2)) = 0 Or Len(arr(i, 3)) = 0 Then GoTo 0
   
9.         If Len(arr(i, 1)) > 0 Then
   
10.             startRow = i
    
11.         End If
    
12.         iSum = iSum + Abs(arr(i, 2) - arr(i, 3))
    
13.         If i = UBound(arr) Then arr(startRow, 4) = iSum: Exit For
    
14.         If Len(arr(i + 1, 1)) > 0 Then
    
15.             arr(startRow, 4) = iSum
    
16.             iSum = 0
    
17.             startRow = 0
    
18.         End If
    
19. 0:
    
20.     Next
    
21.     Range("c3").Resize(UBound(arr), UBound(arr, 2)) = arr
    
22. End Sub
    

复制代码

hwc2ycy

1. Sub 求和()
   
2.     Dim arr, i
   
3.     arr = Range("c3").CurrentRegion     '取C3区域
   
4.     Dim iSum                            '求和
   
5.     Dim startRow                        '开始行标记
   
6.     For i = LBound(arr) + 1 To UBound(arr)
   
7.         '如果有单元格为空，则跳过计算过程
   
8.         If Len(arr(i, 2)) = 0 Or Len(arr(i, 3)) = 0 Then GoTo 0
   
9.         If Len(arr(i, 1)) > 0 Then  '如果C列单元格不为空，则标志着一轮求和开始
   
10.             startRow = i            '要写入求和的行号（此处是数组，则是数组的一维坐标）
    
11.         End If
    
12.         iSum = iSum + Abs(arr(i, 2) - arr(i, 3))    '累加求和，D列减去E列，取绝对值
    
13.         If i = UBound(arr) Then arr(startRow, 4) = iSum: Exit For
    
14.         '如果到达数据最后一行则写入累加数据，退出循环
    
15.         
    
16.         '判断下一行是否有数据标志，如果有，则此轮求和结束
    
17.         If Len(arr(i + 1, 1)) > 0 Then
    
18.             arr(startRow, 4) = iSum     '写入求和
    
19.             iSum = 0                    '清零
    
20.             startRow = 0                '清零
    
21.         End If
    
22. 0:
    
23.     Next
    
24.     Range("c3").Resize(UBound(arr), UBound(arr, 2)) = arr
    
25.     '把计算好的数据回写入单元格
    
26. End Sub

复制代码

qhllqhll

hwc2ycy 发表于 2012-12-11 08:39

您好：为何提示 “下标越界”啊？