[已解决]如何提取不重复的大于1的5个最小数？请帮助，谢谢！

abn223

如何提取不重复的大于1的5个最小数？请帮助，谢谢！

如下图，图中红字就是想要的结果，请帮助，谢谢！

	A	B	C	D	E	F	G	H	I
1	1	1	5	379	5	1070	506		3
2	3	1	5	379	5	1069	506		5
3	3	1	5	378	5	1069	505		6
4	3	1	5	377	5	1068	504		25
5	6	1	5	377	5	1067	504		375
6	6	0	0	376	25	1067	503
7	6	0	0	375	25	1067	502
8	6	0	0	375	25	1067	502
9	6	0	0	375	25	1067	502

最佳答案

月排行榜 / 总排行榜

gufengaoyue

2016-8-29 15:30

自定义函数写了一个，供参考。
Book2 (1).zip (12.94 KB, 下载次数: 3)

2016-8-29 15:29 上传

点击文件名下载附件

跳转到最佳答案楼层

gufengaoyue

自定义函数写了一个，供参考。
Book2 (1).zip (12.94 KB, 下载次数: 3)

2016-8-29 15:29 上传

点击文件名下载附件

abn223

gufengaoyue 发表于 2016-8-29 15:30
自定义函数写了一个，供参考。

你好，谢谢你的帮助，能不能贴上来啊，我哪电脑不能下载，不知怎么着一下就动不了。谢谢！

suye1010

用了一个自定义函数。自定义函数第一个参数是 引用区域，第二个参数是大于的判断条件

zyouong

打开文件 alt F11  打开代码编辑界面 菜单--插入 模块 将下面的代码粘贴进去。 回到文件界面，在需要显示结果的单元格输入=js($A$1:$G$9,ROW(A1)) 下拉
！！！注 代码是      gufengaoyue 编写的

Function js(Rng As Range, i)
Dim arr, Dic
Set Dic = CreateObject("scripting.dictionary")
arr = Rng.Value
For a = 1 To UBound(arr)
    For b = 1 To UBound(arr, 2)
        If arr(a, b) > 1 Then
            Dic(arr(a, b)) = Dic(arr(a, b)) + 1
        End If
    Next
Next
k = Dic.keys
BubbleSort k
js = k(i - 1)
End Function

Sub BubbleSort(ByRef arr)
  Dim i&, j&, vSwap
  For i = UBound(arr) To LBound(arr) + 1 Step -1
    For j = LBound(arr) To i - 1
      If arr(j) > arr(j + 1) Then
        vSwap = arr(j): arr(j) = arr(j + 1): arr(j + 1) = vSwap
      End If
    Next
  Next
End Sub

abn223

suye1010 发表于 2016-8-29 16:02
用了一个自定义函数。自定义函数第一个参数是 引用区域，第二个参数是大于的判断条件

你好，谢谢你的帮助，能不能贴上来啊，我哪电脑不能下载，不知怎么着一下就动不了。谢谢！

abn223

zyouong 发表于 2016-8-29 16:26
打开文件 alt F11  打开代码编辑界面 菜单--插入 模块 将下面的代码粘贴进去。 回到文件界面，在需要显示结 ...

你好，谢谢你的帮助，能不能给个函数公式的？谢谢！