列到字符串

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

请使用下一个函数：

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)

• • 编辑日期**：

请测试返回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

使用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.Keys返回数组[5,4,3]，sepal.Items返回数组[11,12,13]。