（已更新）求大神帮办我

阿醜同學 · 发表于 2019-12-8 00:02

本帖最后由阿醜同學于 2019-12-8 13:46 编辑

求三列数据的多个区间非空值平均值，见EXCEL，但是数据量很大

求大神帮帮忙

liulang0808 · 发表于 2019-12-8 08:14

本帖最后由 liulang0808 于 2019-12-8 08:15 编辑

A列序号是乱的吗？
是否是连续的序号？
楼主的序号，如果是连续的，可以先排序，然后直接求平均值。

liulang0808 · 发表于 2019-12-8 08:23

Sub 按钮1_Click()
arr = [a1].CurrentRegion
For j = 2 To UBound(arr)
For i = j + 1 To UBound(arr)
If arr(j, 1) > arr(i, 1) Then
For k = 1 To UBound(arr, 2)
tm = arr(j, k)
arr(j, k) = arr(i, k)
arr(i, k) = tm
Next k
End If
Next i
Next j
brr = [g1].CurrentRegion
r = 2
For j = 2 To UBound(brr)
If Len(brr(j, 1)) * Len(brr(j, 2)) > 0 Then
sm = 0
sn = 0
For i = r To UBound(arr)
If arr(i, 1) > brr(j, 2) Then
r = i
If sn > 0 Then
brr(j, 3) = sm / sn
End If
Exit For
Else
sm = sm + arr(i, 2) + arr(i, 3)
sn = sn + 2
If i = UBound(arr) Then
If sn > 0 Then
brr(j, 3) = sm / sn
End If
End If
End If
Next i
End If
Next j
[g1].CurrentRegion = brr
End Sub

复制代码

liulang0808 · 发表于 2019-12-8 08:25

附件是考虑序号不连续的情况，供参考。。。。。

一把小刀闯天下 · 发表于 2019-12-8 08:40

'开始序号还有比结束序号大的。可以有交叉，，，

Option Explicit

Sub test()
  Dim arr, brr, i As Long, j As Long, k As Long, sum
  Dim a As Long, b As Long, cnt As Long
  arr = [a1].CurrentRegion.Resize(, 3)
  Call qsort(arr, 2, UBound(arr, 1), 1, 3, 1)
  brr = [g1].CurrentRegion.Resize(, 3)
  For i = 2 To UBound(brr, 1)
If brr(i, 1) < brr(i, 2) Then
   a = brr(i, 1): b = brr(i, 2)
Else
   b = brr(i, 1): a = brr(i, 2)
End If
For j = 2 To UBound(arr, 1)
   If arr(j, 1) >= a Then
      For k = j To UBound(arr, 1)
      If arr(k, 1) > b Then Exit For
      cnt = cnt + 2
      sum = sum + arr(k, 2) + arr(k, 3)
      Next
      brr(i, 3) = sum / cnt: sum = 0: cnt = 0
      Exit For
   End If
Next
  Next
  [g1].CurrentRegion.Resize(, 3) = brr
End Sub

Function qsort(arr, first, last, left, right, key)
  Dim i As Long, j As Long, k As Long, x, t
  i = first: j = last: x = arr((first + last) / 2, key)
  While i <= j
While arr(i, key) < x: i = i + 1: Wend
While x < arr(j, key): j = j - 1: Wend
If i <= j Then
   For k = left To right
      t = arr(i, k): arr(i, k) = arr(j, k): arr(j, k) = t
   Next
   i = i + 1: j = j - 1
End If
  Wend
  If first < j Then qsort arr, first, j, left, right, key
  If i < last Then qsort arr, i, last, left, right, key
End Function

阿醜同學 · 发表于 2019-12-8 13:24

liulang0808 发表于 2019-12-8 08:23

如果B列和C列有空值呢，数列平均值只算有数据的值，需要怎么修改呢

阿醜同學 · 发表于 2019-12-8 13:25

liulang0808 发表于 2019-12-8 08:14
A列序号是乱的吗？
是否是连续的序号？
楼主的序号，如果是连续的，可以先排序，然后直接求平均值。

并非连续序号

liulang0808 · 发表于 2019-12-8 14:31

Sub 按钮1_Click()
arr = [a1].CurrentRegion
For j = 2 To UBound(arr)
For i = j + 1 To UBound(arr)
If arr(j, 1) > arr(i, 1) Then
For k = 1 To UBound(arr, 2)
tm = arr(j, k)
arr(j, k) = arr(i, k)
arr(i, k) = tm
Next k
End If
Next i
Next j
brr = [g1].CurrentRegion
r = 2
For j = 2 To UBound(brr)
If Len(brr(j, 1)) * Len(brr(j, 2)) > 0 Then
sm = 0
sn = 0
For i = r To UBound(arr)
If arr(i, 1) > brr(j, 2) Then
r = i
If sn > 0 Then
brr(j, 3) = sm / sn
End If
Exit For
Else
If Len(arr(i, 2)) > 0 Then
sm = sm + arr(i, 2)
sn = sn + 1
End If
If Len(arr(i, 3)) > 0 Then
sm = sm + arr(i, 3)
sn = sn + 1
End If
If i = UBound(arr) Then
If sn > 0 Then
brr(j, 3) = sm / sn
End If
End If
End If
Next i
End If
Next j
[g1].CurrentRegion = brr
End Sub

复制代码

阿醜同學 · 发表于 2019-12-8 15:10

liulang0808 发表于 2019-12-8 14:31

运行时出现下标越界，

liulang0808 · 发表于 2019-12-8 15:58

阿醜同學发表于 2019-12-8 15:10
运行时出现下标越界，

楼主的表格结构跟之前的是一样大的吗，建议上传附件看看吧

		自动登录	找回密码
密码			免费注册

[求助] （已更新）求大神帮办我

评分

评分

评分

评分