我有 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
ADO
获取 TOP nOption 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
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 (SELECT Name,Sum(Salary) as Salary, " & _
"Sum(Revenue) as Revenue FROM [" & sSrcRng & "] GROUP BY Name) 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
sRSData.Close: Set sRSData = Nothing
oRSCon.Close: Set oRSCon = Nothing
End Sub