按最小值提取不重复的院校

grldrkjhuy

sdytsxd991122 发表于 2023-3-27 16:53

谢谢大佬，就是代码自己要重新写一下，更好

fzxba

grldrkjhuy 发表于 2023-3-27 17:02
谢谢老师，

小改考虑9楼图片情况.rar (87.17 KB, 下载次数: 16)

2023-3-27 17:34 上传

点击文件名下载附件

于箱长

ykcbf1100 发表于 2023-3-27 17:22
不上一下代码吗？

主要是不好意思拿出手，各位老师，不喜请不要扔砖哈

1. Option Explicit
   
2. 
   
3. Sub 开整()
   
4. Dim DicNb As Object: Set DicNb = CreateObject("scripting.dictionary")
   
5. Dim Arr, i, j, Brr(), n
   
6. With Sheets("Sheet1")
   
7.     Arr = .[a1].CurrentRegion
   
8.     For i = 2 To UBound(Arr)
   
9.         If DicNb.exists(Arr(i, 2)) Then
   
10.             If Arr(i, 5) < DicNb(Arr(i, 2)) Then DicNb(Arr(i, 2)) = Arr(i, 5)
    
11.         Else
    
12.             DicNb(Arr(i, 2)) = Arr(i, 5)
    
13.         End If
    
14.     Next
    
15. End With
    
16. ReDim Brr(1 To 1000, 1 To 28)
    
17. For i = 2 To UBound(Arr)
    
18.     If DicNb(Arr(i, 2)) = Arr(i, 5) Then
    
19.     n = n + 1
    
20.     For j = 1 To 28
    
21.         Brr(n, j) = Arr(i, j)
    
22.     Next
    
23.     End If
    
24. Next
    
25. With Sheets("sheet3")
    
26.     .Range("a2:ab" & .[a1048576].End(3).Row + 1).Clear
    
27.     .[a2].Resize(UBound(Brr), 28) = Brr
    
28. End With
    
29. End Sub
    

复制代码

于箱长

ykcbf1100 发表于 2023-3-27 17:22
不上一下代码吗？

发了，审核中

洋务德雷

我来一个SQL+vba版本的。逻辑简单

grldrkjhuy

于箱长 发表于 2023-3-27 20:05
主要是不好意思拿出手，各位老师，不喜请不要扔砖哈

For j = 1 To 28，为何到28？是不是28列？，但是最低分重复的全部提取了，应该要一个就好了

于箱长

grldrkjhuy 发表于 2023-3-28 06:48
For j = 1 To 28，为何到28？是不是28列？，但是最低分重复的全部提取了，应该要一个就好了

28是列数，不想数多少列就用ubound好了

准提部林

1) 各院校最低?  以第5列為準??
2) 將格式也複製
Xl0000003.rar (51.69 KB, 下载次数: 9)

2023-3-28 11:08 上传

点击文件名下载附件

lizhipei78

这种不需要VBA就可以解决了啊

1、自定义排序，添加2021最低分列、院校名称列，按升序排序
2、增加辅助列，对院校进行计数，我是直接在最前面加了辅助列，所以我的公式是A2=COUNTIF(C$1:C2,C2),双击填充即可
3、筛选辅助列为1的就好了

如下图所示

lizhipei78

准提部林 发表于 2023-3-28 11:08
1) 各院校最低?  以第5列為準??
2) 將格式也複製

大神们的代码都是绕来绕去的，搞好复杂，对我个人而言还是喜欢排序后直接提取，代码就超级简单了
如果不想破坏原表，我们可以加一个序号列，后面删除即可，或者直接复制副表进行操作
我的原则是越简单越好