作者：绿色风
分类：
时间：2022-08-17
浏览：116
楼主
kevinchengcw |
Q: 如何利用vba代码剔除偏差值超过平均值10%的数据后重新排序？
A: 代码如下：
- Sub test()
- Dim Arr, Dic As Object, Dic2 As Object, N&, I&, T#, D#, Have As Boolean
- Arr = Range([a2], Cells(Rows.Count, 1).End(3)).Value '读取源数据到数组中
- Set Dic = CreateObject("scripting.dictionary") '创建字典1和字典2
- Set Dic2 = CreateObject("scripting.dictionary")
- For N = LBound(Arr) To UBound(Arr) '将数据装入字典1的items中
- Dic.Add CStr(N), Arr(N, 1)
- Next N
- Do
- Have = False '设定逻辑变量初始值为假
- Arr = Dic.keys '将字典1的keys转给数组用于后面的循环
- T = WorksheetFunction.Sum(Dic.items) / Dic.Count '提取平均值
- For N = LBound(Arr) To UBound(Arr) '循环将同样的key写入字典2中,item是与平均值的差值的绝对值
- Dic2.Add Arr(N), Abs(Dic(Arr(N)) - T)
- Next N
- D = WorksheetFunction.Max(Dic2.items) '取得差值中的最大值
- If D > T * 0.1 Then '如果最大值大于平均值的10%(即我们要求的偏差率上限)
- For N = LBound(Arr) To UBound(Arr) '找到该项,从字典1中删除,并将逻辑变量值设为真,退出循环(每次只删除一个)
- If Dic2(Arr(N)) = D Then
- Dic.Remove Arr(N)
- Have = True
- Exit For
- End If
- Next N
- End If
- Dic2.RemoveAll '清空字典2
- Loop While Have = True '当逻辑值为真时循环
- Arr = Dic.keys '将最后剩余的结果交给数组,用于循环
- T = WorksheetFunction.Sum(Dic.items) / Dic.Count '取得当前的平均值
- For N = LBound(Arr) To UBound(Arr) - 1 '对数据依偏差值从大到小顺序排序
- For I = N + 1 To UBound(Arr)
- If Abs(Dic(Arr(I)) - T) > Abs(Dic(Arr(N)) - T) Then
- D = Dic(Arr(N))
- Dic(Arr(N)) = Dic(Arr(I))
- Dic(Arr(I)) = D
- End If
- Next I
- Next N
- With Cells(2, 2) '清空结果区域,并写入结果
- .Resize(Rows.Count - 1).ClearContents
- .Resize(Dic.Count) = Application.Transpose(Dic.items)
- End With
- Set Dic = Nothing '清空字典项目
- Set Dic2 = Nothing
- End Sub
详见附件及素材源帖。
 测试.rar
|
2楼
海洋之星 |
 代码太长了吧, |
免责声明
有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，
经与ExcelTip.Net站长Apolloh商议并征得其同意，
现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，
供有需要的人士查询使用，也慰缅曾经的论坛时代。
所示各个帖子的原作者如对版权有异议，
可与本人沟通提出，或于本站点留言，我们会尽快处理。
在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一