求解：VBA求列的平均值？

czr0373

czr0373 发表于 2018-8-14 10:26
感谢呀，长知识了，您的劳动成果，我改写了一些，其中黄色部分
求第6列的平均值，严重影响了计算速度，
...

知道问题所在了，把它单独抽出来，脱离循环就没事了。

xiangbaoan

czr0373 发表于 2018-8-14 10:26
感谢呀，长知识了，您的劳动成果，我改写了一些，其中黄色部分
求第6列的平均值，严重影响了计算速度，
...

'不知是否与你的思路一致
Sub test()
Dim ar, sum#, avg#, r&, k&
Application.ScreenUpdating = False
ar = [a1].CurrentRegion.Resize(, 8)
For r = 2 To UBound(ar)
    k = k + 1
    ar(r, 5) = (ar(r, 1) + ar(r, 2)) / 2
    ar(r, 6) = (ar(r, 3) + ar(r, 4)) / 2
    sum = sum + ar(r, 6)
    avg = sum / k
    ar(r, 7) = Rnd
    If ar(r, 6) > avg Then ar(r, 8) = 1 Else ar(r, 8) = -1
Next
[a1].CurrentRegion.Resize(, 8) = ar
Application.ScreenUpdating = True
End Sub
再补一段，你看哪个符合你的思路，下为编辑补充

Sub test()
Dim ar, sum#, avg#, r&, k&
Application.ScreenUpdating = False
ar = [a1].CurrentRegion.Resize(, 8)
For r = 2 To UBound(ar)
    k = k + 1
    ar(r, 5) = (ar(r, 1) + ar(r, 2)) / 2
    ar(r, 6) = (ar(r, 3) + ar(r, 4)) / 2
    sum = sum + ar(r, 6)
    ar(r, 7) = Rnd
Next
avg = sum / k
For r = 2 To UBound(ar)
    If ar(r, 6) > avg Then ar(r, 8) = 1 Else ar(r, 8) = -1
Next
[a1].CurrentRegion.Resize(, 8) = ar
Application.ScreenUpdating = True
End Sub