隔三行求和

lgzxmlg

每隔三行求次和，VBA怎么做？请高手看看

那么的帅

回复 lgzxmlg 的帖子

1. Sub 隔3行求和()
   
2. 
   
3. ROW1 = Sheets("SHEET1").Range("A65536").End(xlUp).Row
   
4. ARR1 = Sheets("SHEET1").Range("A2:A" & ROW1)
   
5. ReDim arr2(1 To UBound(ARR1), 1 To 1)
   
6. Do
   
7. 
   
8. I = I + 1
   
9. If I Mod 3 = 1 Then M = M + 1
   
10. arr2(M, 1) = arr2(M, 1) + ARR1(I, 1)
    
11. Loop While I < UBound(ARR1)
    
12. Sheets("SHEET1").Range("B2").Resize(UBound(arr2), 1) = arr2
    
13. 
    
14. End Sub
    

复制代码

隔三行求和(VBA).rar (7.44 KB, 下载次数: 5)

2010-12-30 23:52 上传

点击文件名下载附件

fjmxwrs

回复 lgzxmlg 的帖子

1. Sub 隔3行求和()
   
2. Dim arr, arr1
   
3. Dim myR&, a&, x&
   
4. With Sheets("sheet1")
   
5. myR = .Range("A65536").End(xlUp).Row
   
6. arr = .Range("A2:A" & myR)
   
7. ReDim arr1(1 To UBound(arr))
   
8. For x = 1 To UBound(arr)
   
9. If x Mod 3 = 1 Then a = a + 1
   
10. arr1(a) = arr1(a) + arr(x, 1)
    
11. Next x
    
12. .Range("B2").Resize(UBound(arr1), 1) = Application.Transpose(arr1)
    
13. End With
    
14. End Sub

复制代码

隔三行求和.zip (9.36 KB, 下载次数: 3)

2010-12-31 01:50 上传

点击文件名下载附件

liuguansky

1. Sub justtest()
   
2.     Dim arr, i&, k&, s&, arrt()
   
3.     k = Cells(1, 1).End(4).Row - 1: s = Application.RoundUp(k / 3, 0)
   
4.     arr = Cells(2, 1).Resize(k, 1).Value
   
5.     ReDim arrt(1 To s, 1 To 1)
   
6.     For i = 1 To k Step 3
   
7.         arrt((i + 2) / 3, 1) = arr(i, 1) + arr(i + 1, 1) + arr(i + 2, 1)
   
8.     Next i
   
9.     Range("b2:b" & Rows.Count).Clear
   
10.     Cells(2, 2).Resize(s, 1) = arrt
    
11. End Sub

复制代码

nothingwmm

liuguansky 发表于 2010-12-31 11:01

{:1112:}{:1112:}
{:1112:}{:1112:}
{:1112:}{:1112:}
{:1112:}{:1112:}
顶花花