如何实现随机4个数取最接近的3个数，再取这3个数的平均值？

wstxd1

请教各位大神，如何实现随机4个数取最接近的3个数，再取这3个数的平均值？
例1，随机四个数分别为0.88，0.72，0.70，0.61，取的三个数为0.88，0.72，0.70，平均值为0.73
例2，随机四个数分别为0.96，0.72，0.70，0.77，取的三个数为0.72，0.70，0.77，平均值为0.74
例3，随机四个数分别为0.62，0.78，0.60，0.62，取的三个数为0.62，0.60，0.62，平均值为0.62
请问各位大神这几种形式的平均值如何实现？小弟拜谢！！！！

Jason_WangSS

有意思的想法，留个标记，学习下

micch

有意思，判断3个数接近，应该就是用3个数的平均值和每个数比较吧，怎么算接近呢。会出现结果不唯一的情况吧

一把小刀闯天下

'先猜一个，，，

Option Explicit

Sub test()
  Dim arr(), i, sum, max, p, n
  ReDim arr(1 To 4)
  For i = 1 To UBound(arr)
    arr(i) = Round(Rnd, 2)
    sum = sum + arr(i)
  Next
  sum = sum / UBound(arr)
  Debug.Print Join(arr, ","), "均值：" & sum
  For i = 1 To UBound(arr, 1)
    If max < Abs(arr(i) - sum) Then max = Abs(arr(i) - sum): p = i
  Next
  sum = 0
  For i = 1 To UBound(arr)
    If i <> p Then
      n = n + 1: arr(n) = arr(i): sum = sum + arr(n)
    End If
  Next
  ReDim Preserve arr(1 To n)
  Debug.Print Join(arr, vbTab), "均值：" & sum / n
End Sub

snowmanjx

先标记一下，回头学习大神的思路

一把小刀闯天下

'这方法好像更合理一些，，，

Option Explicit

Sub test()
  Dim i, j, sum, min, max, p, m, n
  ReDim arr(1 To 4)
  Randomize
  For i = 1 To UBound(arr)
    arr(i) = Round(Rnd, 2)
  Next
  Debug.Print Join(arr, ",")
  ReDim brr(1 To UBound(arr, 1), 1 To UBound(arr, 1) - 1)
  For i = 1 To UBound(arr)
    n = 0
    For j = 1 To UBound(arr)
      If i <> j Then
        n = n + 1
        brr(i, n) = arr(j)
        If n = 1 Then
          min = brr(i, n): max = min
        Else
          If min > brr(i, n) Then min = brr(i, n)
          If max < brr(i, n) Then max = brr(i, n)
        End If
      End If
    Next
    If i = 1 Then
      m = max - min: p = i
    Else
      If m > max - min Then m = max - min: p = i
    End If
  Next
  ReDim arr(1 To UBound(arr) - 1)
  For i = 1 To UBound(arr)
    arr(i) = brr(p, i)
    sum = arr(i) + sum
  Next
  Debug.Print Join(arr, ","), sum / UBound(arr)
End Sub

小鹿一样

马一下。

wstxd1

感谢各位大神的鼎力相助。问题已解决。

kevinchengcw

试下

1. Sub test()
   
2. Dim Arr(), N&, I&, Tmp
   
3. Randomize
   
4. ReDim Arr(1 To 4)
   
5. For N = LBound(Arr) To UBound(Arr)
   
6.     Arr(N) = Round(Rnd, 2)
   
7. Next N
   
8. Debug.Print Join(Arr, vbTab)
   
9. For N = LBound(Arr) To UBound(Arr) - 1
   
10.     For I = N + 1 To UBound(Arr)
    
11.         If Arr(N) > Arr(I) Then
    
12.             Tmp = Arr(N): Arr(N) = Arr(I): Arr(I) = Tmp
    
13.         End If
    
14.     Next I
    
15. Next N
    
16. Debug.Print Join(Arr, vbTab)
    
17. If Arr(2) - Arr(1) > Arr(4) - Arr(3) Then
    
18.     For N = 1 To 3
    
19.         Arr(N) = Arr(N + 1)
    
20.     Next N
    
21. End If
    
22. ReDim Preserve Arr(1 To 3)
    
23. Debug.Print Join(Arr, vbTab)
    
24. Tmp = 0
    
25. For N = LBound(Arr) To UBound(Arr)
    
26.     Tmp = Tmp + Arr(N)
    
27. Next N
    
28. Debug.Print Tmp / UBound(Arr)
    
29. End Sub

复制代码

m_n_j001

Sub test()
  Dim i, sum, max, min
  min = 1: max = -1
  For i = 1 To 4
    Cells(i, 1) = Round(Rnd, 2)
    sum = sum + Cells(i, 1)
    If max < Cells(i, 1) Then max = Cells(i, 1)
    If min > Cells(i, 1) Then min = Cells(i, 1)
  Next
  If max - sum / 4 > sum / 4 - min Then
     Cells(i + 1, 1) = "均值：" & (sum - max) / 3
     Cells(i + 2, 1) = "去掉：" & max
  Else
     Cells(i + 2, 1) = "去掉：" & min
     Cells(i + 1, 1) = "均值：" & (sum - min) / 3
  End If
  End Sub