在数组中选取10个数据，满足平均值及标准差要求。

压力山大根

求助大神，

如图，左侧给出一列数组，输入平均值及标准差。
如何能在A列数组中选取一组10个数据，满足平均值及标准差需求。

（平均值精确至小数点后1位，标准差精确至小数点后3位）

沈默00

VBA版块问问看，，
这是需要凑数、规划求解

ykcbf1100

需要专业知识，没搞懂标准差怎么算，参考gpt写一个吧，能出结果，仅供参考。

ykcbf1100

参与一下。。。

1. Function CalculateMean(arr As Variant) As Double
   
2.     Dim sum As Double
   
3.     Dim count As Long
   
4.     Dim i As Long
   
5.     For i = LBound(arr) To UBound(arr)
   
6.         sum = sum + arr(i)
   
7.         count = count + 1
   
8.     Next i
   
9.     CalculateMean = sum / count
   
10. End Function
    
11. 
    
12. Function CalculateStdDev(arr As Variant, mean As Double) As Double
    
13.     Dim sumSqDiff As Double
    
14.     Dim count As Long
    
15.     Dim i As Long
    
16.     For i = LBound(arr) To UBound(arr)
    
17.         sumSqDiff = sumSqDiff + (arr(i) - mean) ^ 2
    
18.         count = count + 1
    
19.     Next i
    
20.     CalculateStdDev = Sqr(sumSqDiff / count)
    
21. End Function
    
22. 
    
23. Sub SelectNumbersByMeanAndStdDev()
    
24.     r = Cells(Rows.count, 1).End(3).Row
    
25.     numbers = Application.Transpose([a2].Resize(r - 1, 1))
    
26.     targetMean = 29.1 ' 示例平均值
    
27.     targetStdDev = 1.553 ' 示例标准差
    
28.     ' 初始化数组
    
29.     ReDim selection(1 To 10)
    
30.     count = 0
    
31.     ' 计算numbers数组的平均值和标准差
    
32.     mean = CalculateMean(numbers)
    
33.     stdDev = CalculateStdDev(numbers, mean)
    
34.     ' 循环直到选择足够数量的数
    
35.     Do While count < 10
    
36.         ' 随机选择数组中的一个数
    
37.         randomIndex = Int((UBound(numbers) - LBound(numbers) + 1) * Rnd + LBound(numbers))
    
38.         ' 检查这个数是否满足条件
    
39.         If Abs(numbers(randomIndex) - targetMean) <= targetStdDev Then
    
40.             ' 如果满足条件，添加到选择数组中
    
41.             count = count + 1
    
42.             selection(count) = numbers(randomIndex)
    
43.         End If
    
44.     Loop
    
45.     ' 输出结果
    
46.     For i = 1 To 10
    
47.         Cells(i + 1, "g") = selection(i)
    
48.     Next i
    
49. End Sub
    

复制代码

压力山大根

ykcbf1100 发表于 2024-8-15 18:43
需要专业知识，没搞懂标准差怎么算，参考gpt写一个吧，能出结果，仅供参考。

运行不了好像，编译错误

ykcbf1100

压力山大根 发表于 2024-8-15 19:04
运行不了好像，编译错误

我这里是能运行的。

如果你运行出错，应该是版本原因吧。

压力山大根

我这边显示这个，大佬

kevinchengcw

压力山大根

kevinchengcw 发表于 2024-8-16 15:01

你好，应该是STDEV.S，不过能发下文件吗？

jaxxcyh

这个应该是用“规划求解”才能搞定吧？不敢俺不熟悉怎么弄那玩意儿。高手来指点吧。