使用VBA中的for循环将数组保存在字典中

Question

我有一张包含要保存在字典中的数据的数组的工作表。每个数组之间的列空间是恒定的，并且表的大小相似。我在每个数组（单元格 J3 中的第一个）上都有名称，它们应该是键，数据应该是项。如何创建一个循环来保存所有数组并在所选范围为空时停止？

 Sub Dictionary()

    Dim dictionary() As Dictionary
    
    Dim nCol As Integer, i As Integer
    nCol = 13
    
    Sheets("Sheet1").Activate
    Range(Cells(27, 11), Cells(36, 21)).Activate
   
    For i = 1 To nCol
'        dictionary(i) = Selection.Value
        Selection.Offset(RowOffset:=0, ColumnOffset:=nCol).Select
    Next i
   
    
 End Sub

谢谢

Answer 1

请测试下一个代码。它需要引用“Microsoft Scripting Runtime”：

Sub RangesIndictionary()
    Dim sh As Worksheet, dict As New scripting.dictionary, nCol As Long
    Dim i As Long, rngInit As Range, rngKey As Range, keyName As String
    
    Set sh = Sheets("Sheet1")
    nCol = 13

    Set rngKey = sh.Range("J3")
    keyName = rngKey.Value
    Set rngInit = sh.Range(sh.cells(27, 11), sh.cells(36, 21))

    Do While keyName <> ""
        dict.Add keyName, rngInit
        Set rngKey = rngKey.Offset(0, nCol)
        keyName = rngKey.Value
        Set rngInit = rngInit.Offset(0, nCol)
    Loop
    Debug.Print dict.count & " ranges have been placed in the dictionary"
    Debug.Print "The first range is " & dict(sh.Range("J3").Value).Address
 End Sub

它可以使用后期绑定，但最好使用智能感知建议的参考和好处。

如果两个这样的范围的名称可能相同，则代码应初步检查键是否存在。并且您必须告诉我们如何处理这种情况。

为了自动添加必要的引用，请先运行下一段代码：

Sub addScrRunTimeRef()
  'Add a reference to 'Microsoft Scripting Runtime':
  'In case of error ('Programmatic access to Visual Basic Project not trusted'):
  'Options->Trust Center->Trust Center Settings->Macro Settings->Developer Macro Settings->
  '         check "Trust access to the VBA project object model"
  On Error Resume Next
  Application.VBE.ActiveVBProject.References.AddFromFile "C:\Windows\SysWOW64\scrrun.dll"
  If err.Number = 32813 Then
        err.Clear: On Error GoTo 0
        MsgBox "The reference already exists...": Exit Sub
  Else
        On Error GoTo 0
        MsgBox """Microsoft Scripting Runtime"" reference added successfully..."
  End If
End Sub

仅当您保存工作工作簿时才会保留...