对大于3后的最小五个数值进行筛选

李红艳

对大于3后的最小五个数值进行筛选 五小筛选.rar (10.13 KB, 下载次数: 27)

2018-9-12 08:06 上传

点击文件名下载附件

李兴德

不明白楼主的意图是什么

microyip

无标题SQL语句查询即可

1. Select Top 5 [F1] From [Sheet2$D8:D27] Where [F1]>3 Order By [F1]

复制代码

Kaohsing

Sub kao()
    Set arr = [D8:D100]
    Set x = CreateObject("scriptcontrol"):    x.Language = "jscript"
    x.eval "function aa(aa) {return aa.value.toArray()}"
    Set y = x.Run("aa", arr):    x.AddObject "a", y
    x.eval "var o={};var d=[];for(j=0;j<a.length;j++){ if( a[j]>3){ if(!o[a[j]]){o[a[j]] ='ture';d.push(a[j]);}}}; var result=d.sort(function(a,b){return a-b;}).splice(0,5);"
    MsgBox x.eval("result")
End Sub

Chip_Kenny

1. Sub zz()
   
2. Dim a(), n&, s$, i
   
3. ar = Range("d8:d" & [d1048576].End(3).Row).Value
   
4. ReDim a(Application.Max(ar))
   
5. For Each i In ar
   
6.     If i Then a(i) = i
   
7. Next
   
8. With CreateObject("vbscript.regexp")
   
9.     .Pattern = "\|{2,}": .Global = True
   
10.     ar = Split(.Replace("||" & Join(a, "|") & "||", "|"), "|")
    
11. End With
    
12. For i = 1 To UBound(ar) - 1
    
13.     If Val(ar(i)) > 3 Then
    
14.         For j = i To i + 4
    
15.             s = s & "," & ar(j)
    
16.         Next
    
17.         GoTo 1000
    
18.     End If
    
19. Next
    
20. 1000
    
21. [a7].CurrentRegion.AutoFilter 4, Split(Mid(s, 2), ","), 7
    
22. End Sub

复制代码

lsdongjh

1. Sub SelectValByNum()
   
2.     Dim Conn As Object, Rst As Object, strPath As String
   
3.     Dim strConn As String, strSQL As String
   
4. 
   
5.     Set Conn = CreateObject("ADODB.Connection")
   
6.     Set Rst = CreateObject("ADODB.Recordset")
   
7.     strPath = ThisWorkbook.FullName
   
8.     Select Case Application.Version * 1
   
9.         Case Is <= 11
   
10.             strConn = "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=excel 8.0;Data source=" & strPath
    
11.         Case Is >= 12
    
12.             strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strPath & ";Extended Properties=""Excel 12.0;HDR=NO"";"""
    
13.     End Select
    
14.     Conn.Open strConn
    
15.    
    
16.     strSQL = "SELECT * FROM  [Sheet2$A8:O27]  WHERE [F4] IN (SELECT Top 5 [F1] FROM [Sheet2$D8:D27]  WHERE [F1] > 3  Group By [F1]  Order By [F1]) "
    
17. 
    
18.     Rst.Open strSQL, Conn, 3, 1
    
19. 
    
20.     Sheet2.Range("A39").CopyFromRecordset Rst
    
21. 
    
22.     Set Rst = Nothing
    
23.     Set Conn = Nothing
    
24. End Sub

复制代码

一把小刀闯天下

Option Explicit

Sub test()
  Dim arr, brr, dic, i, j, t, n
  Set dic = CreateObject("scripting.dictionary")
  With Sheets("sheet2")
    arr = .Range("a8:p" & .Cells(Rows.Count, "o").End(xlUp).Row)
  End With
  brr = arr
  For i = 1 To UBound(brr, 1) - 1
    For j = i + 1 To UBound(brr, 1)
      If brr(i, 4) > brr(j, 4) Then
        t = brr(i, 4): brr(i, 4) = brr(j, 4): brr(j, 4) = t
      End If
  Next j, i
  For i = 1 To UBound(brr, 1)
    If brr(i, 4) > 3 And Not dic.exists(brr(i, 4)) Then dic(brr(i, 4)) = vbNullString
    If dic.Count = 5 Then Exit For
  Next
  For i = 1 To UBound(arr, 1)
    If dic.exists(arr(i, 4)) Then
      n = n + 1
      For j = 1 To UBound(arr, 2): arr(n, j) = arr(i, j): Next
    End If
  Next
  With Sheets("五小").[a10]
    .Resize(Rows.Count - 9, UBound(arr, 2)).ClearContents
    If n > 0 Then .Resize(n, UBound(arr, 2)) = arr
  End With
End Sub

duquancai

凑个热闹            

不知道为什么

不错哦，百家争鸣，百家齐放的赶脚！论坛就是要这样的氛围！