请教：循环去除超范围平均百分数

鄂龙蒙

目前测试数据第3次去除达到要求了，但由于数据是动态增减变动的，有时可能要去除4次、5次。。。。想请教用循环去除的方法，代码怎么改？谢谢！

动态平均数循环.rar (21.71 KB, 下载次数: 5)

2017-3-11 19:10 上传

点击文件名下载附件

yayahzmeng

你的所谓第3次弟4次去除后的结果明显是错的。

1. Sub tstt()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     n = [a2].End(4).Row
   
4.     Range("u2:v" & n).ClearContents
   
5.     arr = Range("A2:B" & n)
   
6.     For i = 1 To UBound(arr)
   
7.         d(arr(i, 1)) = arr(i, 2)
   
8.     Next
   
9.     Do
   
10.         ic = d.Count                       '当前字典里的key个数
    
11.         nm = Application.Average(d.items)  '当前均值
    
12.         imin = Application.Min(d.items)    '当前最小
    
13.         imax = Application.Max(d.items)    '当前最大
    
14.         For i = 0 To d.Count - 1
    
15.             IName = d.keys()(i)
    
16.             If d(IName) = imin Then ikey = IName   '找到当前最小的key
    
17.             If d(IName) = imax Then jkey = IName   '找到当前最大的key
    
18.         Next
    
19.         If Abs(imin - nm) / nm > 0.2 Then d.Remove ikey  '如最小值超，则删除对应key
    
20.         If Abs(imax - nm) / nm > 0.2 Then d.Remove jkey  '如最大值超，则删除对应key
    
21.         If d.Count = ic Then Exit Do       '如删除后key个数与删除前相同，退出loop
    
22.     Loop
    
23.     [u2].Resize(d.Count) = Application.Transpose(d.keys)
    
24.     [v2].Resize(d.Count) = Application.Transpose(d.items)
    
25. End Sub

复制代码

请测试附件