- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
4#
發表於 2014-10-29 13:47
| 只看該作者
本帖最後由 GBKEE 於 2014-10-29 13:50 編輯
回復 3# t8899
Large函數 不是真的傳回數值資料中的第幾大- Sub EX()
- Dim AR, k
- AR = Array(5, 5, 6, 6, 7, 7, 8)
- ' AR = Array(5, 6, 7, 5, 6, 7, 8)
- For k = 1 To UBound(AR) + 1
- MsgBox "第 " & k & " 大 : " & Application.Large(AR, k)
- Next
- End Sub
- Option Explicit
- Dim D As Object
- Private Sub CommandButton1_Click()
- Range("K3:S" & Rows.Count).ClearContents
- Dim a As Range, b As Long, k As Integer, aD As String
- 排序值 Range("g2:g857")
- For k = 1 To IIf(D.Count >= 50, 50, D.Count)
- b = Application.Large(D.KEYS, k)
- Set a = Range("g2:g857").Find(What:=b, LookIn:=xlValues, lookat:=xlWhole)
- If Not a Is Nothing Then aD = a.Address
- Do While Not a Is Nothing
- Range("K100").End(xlUp).Offset(1) = a.Offset(0, -6) '代號
- Range("L100").End(xlUp).Offset(1) = a.Offset(0, -5) '名稱
- Range("M100").End(xlUp).Offset(1) = a.Offset(0, 0) ' 張
- Range("N100").End(xlUp).Offset(1) = a.Offset(0, -4) '價位
- Set a = Range("g2:g857").FindNext(a)
- If a.Address = aD Then Exit Do
- Loop
- Next
- 排序值 Range("h2:h857")
- For k = 1 To IIf(D.Count >= 50, 50, D.Count)
- b = Application.Large(D.KEYS, k)
- Set a = Range("h2:h857").Find(What:=b, LookIn:=xlValues)
- If Not a Is Nothing Then aD = a.Address
- Do While Not a Is Nothing
- Range("P100").End(xlUp).Offset(1) = a.Offset(0, -7) '代號
- Range("Q100").End(xlUp).Offset(1) = a.Offset(0, -6) '名稱
- Range("R100").End(xlUp).Offset(1) = a.Offset(0, 0) ' 張
- Range("S100").End(xlUp).Offset(1) = a.Offset(0, -2) '價位
- Set a = Range("h2:h857").FindNext(a)
- If a.Address = aD Then Exit Do
- Loop
- Next
- End Sub
- '***********
- Private Sub 排序值(Rng As Range) '排除有重複的數值
- Dim e As Range
- Set D = CreateObject("SCRIPTING.DICTIONARY")
- For Each e In Rng.SpecialCells(xlCellTypeConstants)
- If IsNumeric(e) Then D(e.Value) = ""
- Next
- End Sub
|
|
發表於 2014-10-28 20:46
| 
