无意翩阅一精彩贴子看到这样题目这VBA代码怎么写呢？

niko88819

问题1. 每五行找出最大值结果如 B 列 代码
问题2. 每五行找出最大值结果如 C 列 代码
问题3. 每五行找出最大值结果总和如 C 列 代码


小师妹的VBA是幼儿园程度要向老师跟版主们学习 学习请指导啰
小师妹是位好奇宝宝,好学 (爱学习)

z403025335

Sub MAX()
Dim n&, i&, s&
n = Range("a" & Rows.Count).End(xlUp).Row
For i = 1 To WorksheetFunction.RoundUp(n / 5, 0)
    Range("b" & i * 5 - 4) = WorksheetFunction.MAX(Range("a" & i * 5 - 4 & ":a" & i * 5))
    Range("c" & i) = Range("b" & i * 5 - 4)
    s = s + Range("b" & i * 5 - 4)
Next i
    Range("d1") = s
End Sub

niko88819

z403025335 发表于 2018-7-1 12:21
Sub MAX()
Dim n&, i&, s&
n = Range("a" & Rows.Count).End(xlUp).Row

老师您太棒了感谢您热心解答了！

少少飞翔

紫薯布丁紫薯布丁

chaohuahch

数组的解法，能用数组解决的，就用数组解决。

1. Sub test()
   
2. Dim i, j, arr, k, n, g, t
   
3. t = Timer
   
4. n = Range("a" & Rows.Count).End(3).Row
   
5. j = 1
   
6. For i = 1 To n Step 5
   
7.     arr = Cells(i, 1).Resize(5)
   
8.     k = Application.max(arr)
   
9.     Cells(j, 3) = k
   
10.     j = j + 1
    
11.      For g = i To i + 4
    
12.         If Cells(g, 1) = k Then
    
13.         Cells(g, 2) = k
    
14.         End If
    
15.      Next g
    
16. 
    
17. Next i
    
18. [d1] = Application.WorksheetFunction.Sum(Range("c:c"))
    
19. MsgBox "本程序用时" & Format(Timer - t, "0.000")
    
20. End Sub
    

复制代码

请使用手机"扫一扫"x

mythqiu

好帖。好帖。。。

niko88819

感谢各层楼的老师,您们太棒了感谢您热心解答了！

Kaohsing

         

1. Sub test()
   
2.     Dim ghb(), tt%, n%, i%
   
3.     t = Timer
   
4.     n = [a1].End(4).Row
   
5.     ReDim ghb(1 To n, 1 To 3)
   
6.     For i = 1 To n Step 5
   
7.         k = k + 1
   
8.         tt = Application.Max(Cells(i, 1).Resize(5))
   
9.         ghb(k, 2) = tt
   
10.         If i = n Then
    
11.             ghb(i, 1) = tt
    
12.         Else
    
13.             ghb(i + 4, 1) = tt
    
14.         End If
    
15.     Next i
    
16.     ghb(1, 3) = Application.WorksheetFunction.Sum(ghb) / 2
    
17.     [b1].Resize(n, 3) = ghb
    
18.    
    
19.     MsgBox "本程序用时" & Format(Timer - t, "0.000")
    
20. End Sub
    

复制代码

香川群子

test 是3个要求一起实现的代码。
然后test1、test2、test3，是各个要求各自实现的代码。

1. Sub test()
   
2.     m = [a1].End(4).Row
   
3.     ar = [a1].Resize(m + 4)
   
4.    
   
5.     ReDim br(1 To m, 1 To 3)
   
6.     For i = 1 To m Step 5
   
7.         t = ar(i, 1): r = i
   
8.         For i2 = i + 1 To i + 4
   
9.             If ar(i2, 1) > t Then t = ar(i2, 1): r = i2
   
10.         Next
    
11.         br(r, 1) = t
    
12.         k = k + 1: br(k, 2) = t
    
13.         s = s + t
    
14.     Next
    
15.     br(1, 3) = s
    
16.     [b1].Resize(m, 3) = br
    
17. End Sub
    
18. Sub test1()
    
19.     m = [a1].End(4).Row
    
20.     ar = [a1].Resize(m + 4)
    
21.    
    
22.     ReDim br(1 To m, 1 To 1)
    
23.     For i = 1 To m Step 5
    
24.         t = ar(i, 1): r = i
    
25.         For i2 = i + 1 To i + 4
    
26.             If ar(i2, 1) > t Then t = ar(i2, 1): r = i2
    
27.         Next
    
28.         br(r, 1) = t
    
29.     Next
    
30.     [b1].Resize(m) = br
    
31. End Sub
    
32. Sub test2()
    
33.     m = [a1].End(4).Row
    
34.     ar = [a1].Resize(m + 4)
    
35.    
    
36.     ReDim br(1 To m, 1 To 1)
    
37.     For i = 1 To m Step 5
    
38.         t = ar(i, 1)
    
39.         For i2 = i + 1 To i + 4
    
40.             If ar(i2, 1) > t Then t = ar(i2, 1)
    
41.         Next
    
42.         k = k + 1
    
43.         br(k, 1) = t
    
44.     Next
    
45.     [c1].Resize(k) = br
    
46. End Sub
    
47. Sub test3()
    
48.     m = [a1].End(4).Row
    
49.     ar = [a1].Resize(m + 4)
    
50.    
    
51.     For i = 1 To m Step 5
    
52.         t = ar(i, 1)
    
53.         For i2 = i + 1 To i + 4
    
54.             If ar(i2, 1) > t Then t = ar(i2, 1)
    
55.         Next
    
56.         s = s + t
    
57.     Next
    
58.     [d1] = s
    
59. End Sub
    

复制代码

niko88819

大师姐老师，是小师妹祟拜偶像，对幼儿园的小师妹来说是学习的快速方法。只有感感恩加感谢中...
*** 学艺跟对老师少走很多弯路！