Как мне написать в VBA для захвата столбцов из нескольких листов в один объект словаря Excel

Question

У меня 12 листов с данными в тех же столбцах, что и все в одном словаре. Я плохо понимаю объект словаря. Я надеюсь, что я могу назначить все 12 листов (2 строки на листе) в одном утверждении. Если нет, то должен ли я пройти по 12 раз и как-то назначить этот путь? Спасибо. geddeca

Вот код, который успешно работал для захвата 2 столбцов в один объект словаря.

Set dict = CreateObject("scripting.dictionary")
dict.comparemode = vbTextCompare
With Worksheets(w)

        'collect values from worksheet
        arr = .Range(.Cells(2, "A"), .Cells(.Rows.Count, "B").End(xlUp)).Value2
        Debug.Print w

        'process dictionary of list and count
        dict.RemoveAll ... more code

Это код, с которым я перебираю листы для итогов отдельных листов. Это не сработает для того, что я ищу. Два столбца данных взяты из 12 листов, а затем отсортированы по уникальным идентификаторам.

Sub CREBSort()

Dim i As Long, j As Long, w As Long
Dim arr As Variant, dict As Object
Dim WS_Count As Integer
Dim rowString As String

Set dict = CreateObject("scripting.dictionary")
dict.comparemode = vbTextCompare

WS_Count = ActiveWorkbook.Worksheets.Count
Debug.Print WS_Count
rowString = ""


For w = 1 To WS_Count
    With Worksheets(w)

        'collect values from worksheet
        arr = .Range(.Cells(2, "L"), .Cells(.Rows.Count, "M").End(xlUp)).Value2
        Debug.Print w

        'process dictionary of list and count
        dict.RemoveAll

        '        Debug.Print "The array is: "

        For i = LBound(arr, 1) To UBound(arr, 1)
        rowString = arr(i, 1)
             For j = LBound(arr, 2) To UBound(arr, 2)
                dict.Item(arr(i, j)) = dict.Item(arr(i, j)) + 1

             Next j

        Next i
'return new values to worksheet
        .Cells(1, "W").Resize(1, 2) = Array("list", "count")
        .Cells(2, "W").Resize(dict.Count, 1) = Application.Transpose(dict.Keys)
        .Cells(2, "X").Resize(dict.Count, 1) = Application.Transpose(dict.items)
        'sort values by count descending then name ascending
         With .Range(.Cells(1, "W"), .Cells(.Rows.Count, "X").End(xlUp))
            .Sort key1:=.Columns(2), order1:=xlDescending, _
                  key2:=.Columns(1), order2:=xlAscending, _
                  Header:=xlYes
        End With

 End With
Next w


End Sub