Excel 数据到字典使用 VBA

Question

比如我在excelsheet'MySheet'中有一些数据如下：

sepal	petal
5	11
4	12
3	13

我需要在调用名为 dict= ex_dict () 的 VBA 函数后将这些数据转换成字典，我可以在其中访问每个键像：[=15=]

dict=ex_dict(A1:B4)
dict= {"sepal": [5,4,3], "petal": [11,12,13]}

或

dict ('sepal')= [5,4,3]

起初，我以为我找到了解决办法。但后来我发现给定的解决方案输出为字符串而不是字典对象

Answer 1

列到字符串

Function ex_dict(ByVal rg As Range) As String
    
    Dim rCount As Long: rCount = rg.Rows.Count
    If rCount < 2 Then Exit Function
    
    ex_dict = "{"
    
    Dim crg As Range
    Dim r As Long
    
    For Each crg In rg.Columns
        ex_dict = ex_dict & """" & crg.Cells(1).Value & """: ["
        For r = 2 To rCount
            ex_dict = ex_dict & crg.Cells(r).Value & ","
        Next r
        ex_dict = Left(ex_dict, Len(ex_dict) - 1) & "], "
    Next crg
    
    ex_dict = Left(ex_dict, Len(ex_dict) - 2) & "}"

End Function

Answer 2

使用 Dictionary Object.

Sub Example()
    'Create a Dictionary object
    Dim sepal As Object
    Set sepal = CreateObject("Scripting.Dictionary")
    
    'Loop through the table
    Dim Cell As Range
    For Each Cell In Range("A2:A5")
        'Add unique entries to the dictionary
        If Not sepal.exists(Cell.Value) Then
            'Add cell value as the Key & the adjacent value as the Item.
            sepal.Add Cell.Value, Cell.Offset(, 1).Value
        End If
    Next
    
    Debug.Print sepal(4) 'returns 12
    Debug.Print sepal(3) 'returns 13
End Sub

建字典后，sepal.Keysreturns数组[5,4,3]和sepal.Itemsreturns数组[11,12,13].

Answer 3

请使用下一个功能：

Function ex_dictX(rng As Range) As String
   Dim dict As Object, i As Long, j As Long, arr, strIt As String
   
   Set dict = CreateObject("Scripting.Dictionary")
   
   arr = rng.Value2: strIt = "["
   For i = 1 To UBound(arr, 2)
       For j = 2 To UBound(arr)
            strIt = strIt & arr(j, i) & ","
       Next j
        dict.Add Chr(34) & arr(1, i) & Chr(34) & ": ", left(strIt, Len(strIt) - 1) & "]"
        strIt = "["
   Next i
   'build the string to be returned (as pseudo dictionary):
   For i = 0 To dict.count - 1
        strIt = strIt & dict.Keys()(i) & dict.items()(i) & ", "
   Next
 
   ex_dictX = "{" & left(strIt, Len(strIt) - 2) & "}"
End Function

可以用简单的Sub来测试：

Sub tesTex_dict()
    Debug.Print ex_dict(Range("A1:B4"))
End Sub

或从单元格中将其作为 UDF（用户定义函数）调用为：

 =ex_dict(A1:B4)

已编辑:

请测试下一个版本 returns a Scripting.Dictionary:

Function ex_dictD(rng As Range) As Object
   Dim dict As Object, i As Long, j As Long, arr, strIt As String
   
   Set dict = CreateObject("Scripting.Dictionary")
   
   arr = rng.Value2: strIt = "["
   For i = 1 To UBound(arr, 2)
       For j = 2 To UBound(arr)
            strIt = strIt & arr(j, i) & ","
       Next j
        dict.Add Chr(34) & arr(1, i) & Chr(34), left(strIt, Len(strIt) - 1) & "]"
        strIt = "["
   Next i
 
   Set ex_dictD = dict
End Function

它可以在 Sub 中进行测试，如下所示：

Sub testEx_dict()
    Dim dict As Object, i As Long
    Set dict = ex_dictD(Range("A1:C4"))
    
    For i = 0 To dict.count - 1
        Debug.Print dict.Keys()(i) & " = " & dict.items()(i)
    Next
End Sub

Excel 数据到字典使用 VBA

Excel data to a dictionary using VBA

excel

vba

dictionary

列到字符串