VBA - 从多个工作表和范围创建字典

Question

我正在从多个工作表和范围创建字典。 我的代码正在运行，但看起来非常不愉快。 在我的知识中应该缺少一些基本的东西，这并不奇怪，因为这是我在 VBA 中的第一个项目。 如何在一个循环中实现这一点？ 非常感谢任何帮助。

    ' Get the range of all the adjacent data using CurrentRegion
Dim rg1 As Range, rg2 As Range, rg3 As Range, rg4 As Range, rg5 As Range, rg6 As Range, rg7 As Range
Set rg1 = sheet1.Range("A1").CurrentRegion
Set rg2 = sheet2.Range("A1").CurrentRegion
Set rg3 = sheet3.Range("A1").CurrentRegion
Set rg4 = sheet4.Range("A1").CurrentRegion
Set rg5 = sheet5.Range("A1").CurrentRegion
Set rg6 = sheet6.Range("A1").CurrentRegion
Set rg7 = sheet7.Range("A1").CurrentRegion


Dim oID As clsItem, i As Long, j As Long, Id As Long
'read through the data

    For i = 3 To rg1.rows.count

        Id = rg1.Cells(i, 1).value

        ' Create a new clsDetector object
        Set oID = New clsItem

        ' Add the new clsDetector object to the dictionary
        dictName.add Id, oID

        ' Set the values
        oID.ItemName = rg1.Cells(i, 70).value

    Next i

'
'
'Same loops for rg2, rg3, rg4, rh5, rg6 and rg7
'
'

Answer 1

由于工作表从 1 变为 7，因此您可以像这样循环遍历它们。

Sub LoadRangesIntoDict()
    Dim i As Integer
    Dim s As Integer
    Dim ws As Worksheet
    Dim rng As Range
    
    Dim oID As clsItem, i As Long, j As Long, Id As Long
    
    ' Loop through each sheet
    For s = 1 To 7
        Set ws = Sheets("Sheet" & s)
        Set rng = ws.Range("A1").CurrentRegion
        
        'read through the data
        For i = 3 To rng.Rows.Count

            Id = rng.Cells(i, 1).Value

            ' Create a new clsDetector object
            Set oID = New clsItem

            ' Add the new clsDetector object to the dictionary
            dictName.Add Id, oID

            ' Set the values
            oID.ItemName = rng.Cells(i, 70).Value
            
        Next i
    Next s
End Sub