热衷于在 VBA (Excel) 中按嵌套字典的项目对字典进行排序？

Question

我有 Excel 中的示例数据：

尝试通过 Salary 获取 Top-3 元素（名称）并通过 Revenue 获取 Top-3 元素（名称）。

---

在 Visual Basic (VBA) 中，我创建了字典，名称为

Key

，嵌套字典为

Item

嵌套字典有“

Salary

”，“

Revenue

”和“

Position

”作为Keys。对应的值为 Items.

我创建的字典如下：

Dim MainDict As New Scripting.Dictionary
Dim NestedDict As Scripting.Dictionary
    
Dim rngRange As Range
Set rngRange = wsMainWorkSheet.Range("B2:E8")

Dim rowCounter As Long
  
For rowCounter = 1 To rngRange.Rows.Count
    Set NestedDict = New Dictionary
    NestedDict.Add key:="Salary", Item:=rngRange(rowCounter, 2)
    NestedDict.Add key:="Revenue", Item:=rngRange(rowCounter, 3)
    NestedDict.Add key:="Position", Item:=rngRange(rowCounter, 4)
    
    Dim mainKey As String
    mainKey = CStr(rngRange(rowCounter, 1))
    If MainDict.Exists(mainKey) = False Then
        MainDict.Add key:=mainKey, Item:=NestedDict
    Else:
        MainDict.Item(mainKey)("Salary") = MainDict.Item(mainKey)("Salary") + rngRange(rowCounter, 2)
        MainDict.Item(mainKey)("Revenue") = MainDict.Item(mainKey)("Salary") + rngRange(rowCounter, 3)
    End If
Next rowCounter

---

现在如果我通过代码在字典中打印

Key, Items

：

Sub PrintDictionary(dict As Dictionary)
Dim key As Variant, subKey As Variant

For Each key In dict.Keys
    Debug.Print vbNewLine; "Name: " & key
    For Each subKey In dict(key).Keys
        Debug.Print subKey & ": " & dict(key)(subKey)
    Next subKey
Next key
End Sub

结果：

姓名：姓名1 工资：400 收入：5000 职位：经理

姓名：姓名2 工资：500 收入：25000 职位：助理

（仅显示前 2 个）

---

但我无法弄清楚以下内容：

• 如何按最大薪水获取列表的前 3 个元素（名称）（嵌套字典中的“Salary”键）。

• 如何按最大收入获取列表的前 3 个元素（名称）（嵌套字典中的“Revenue”键）。

是否可以在 VBA 中基于嵌套字典的项目对主字典进行排序，而无需在 Excel 表本身中对数据进行预排序？是否可以对这种结构中的数据进行排序以供以后进一步使用？

Book1.xlsm（示例数据）可在 DropBox 上找到：Book1.xlsm

Answer 1

• 使用

  ADO

  获取 TOP n

Option Explicit

Sub ADO_TOP()
    Dim sSrcFile As String
    Dim sSrcSht As String
    Dim oRSCon As Object, sRSData As Object, sDBCon As String, sSQL As String
    Dim i As Long, sSrcRng As String
    Sheet1.Select
    sSrcFile = ThisWorkbook.FullName
    sSrcSht = "Sheet1"
    If Val(Application.Version) < 12 Then
        sDBCon = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
            "Data Source=" & sSrcFile & ";" & _
            "Extended Properties=""Excel 8.0;HDR=YES"";"
    Else
        sDBCon = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
            "Data Source=" & sSrcFile & ";" & _
            "Extended Properties=""Excel 12.0;HDR=YES"";"
    End If
    Set oRSCon = CreateObject("ADODB.Connection")
    Set sRSData = CreateObject("ADODB.Recordset")
    sSrcRng = sSrcSht & "$" & Sheets(sSrcSht).Range("A2").CurrentRegion.Address(0, 0)
    oRSCon.Open sDBCon
    sSQL = "SELECT TOP 3 * FROM [" & sSrcRng & "] ORDER BY Salary DESC"
    sRSData.Open sSQL, oRSCon, 0, 1, 1
    ' Write the output data to newsheet
    ' TOP 3 Salray
    Sheets.Add
    Range("A1") = "TOP 3 Salray"
    For i = 0 To sRSData.Fields.Count - 1
        Cells(3, i + 1).Value = sRSData.Fields(i).Name
    Next i
    Range("A4").CopyFromRecordset sRSData
    ' TOP 3 Revenue
    sRSData.Close
    sSQL = "SELECT TOP 3 * FROM [" & sSrcRng & "] ORDER BY Revenue DESC"
    sRSData.Open sSQL, oRSCon, 0, 1, 1
    Sheets.Add
    Range("A1") = "TOP 3 Revenue"
    For i = 0 To sRSData.Fields.Count - 1
        Cells(3, i + 1).Value = sRSData.Fields(i).Name
    Next i
    Range("A4").CopyFromRecordset sRSData
    
    sRSData.Close: Set sRSData = Nothing
    oRSCon.Close: Set oRSCon = Nothing
End Sub