Блог

Главная - Вопросы по программированию - Добавление элементов в массив в словаре

Добавление элементов в массив в словаре

#arrays #excel #vba #dictionary

#массивы #excel #vba #словарь

Вопрос:

У меня есть словарь, и я хочу добавить новые строки к элементам. Моя идея состоит в том, чтобы создать список строк как item для каждого key .

Мой код пока:

 Sub AccountEntitlements()

    Dim sh1 As Worksheet
    Dim acc As Worksheet
    Dim arr() As Variant
    Dim d As Variant
    Dim i As Long
    Dim count As Long

    Set sh1 = Sheets("Sheet1")
    Set acc = Sheets("accountsentitlements")
    Set d = CreateObject("Scripting.Dictionary")

    arr = sh1.Range("D:F")

    For i = LBound(arr) To UBound(arr)
        If d.Exists(arr(i, 3)) Then
            ReDim Preserve arr(UBound(arr)   1) '<- Error line
            d(arr(i, 3)) = Array(arr(i, 1))
        Else
            d.Add Key:=arr(i, 3), Item:=Array(arr(i, 1))
        End If

    Next i

    For count = 1 To d.count - 1
        acc.Cells(count   1, "D").Value = UCase(d.Keys()(count))
        acc.Cells(count   1, "E").Value = d.Items()(count)
    Next count

End Sub

Сообщение об ошибке является Run-time error '9': Subscript out of range .

Важным блоком кода является

 For i = LBound(arr) To UBound(arr)
     If d.Exists(arr(i, 3)) Then
          ReDim Preserve arr(UBound(arr)   1) '<- Error line
          d(arr(i, 3)) = Array(arr(i, 1))
     Else
          d.Add Key:=arr(i, 3), Item:=Array(arr(i, 1))
     End If

Ключом словаря является учетная запись пользователя, а элементами должны быть их группы членства.
Пример:

Ключ = ABCD , элемент= Правообладатель1, Правообладатель2 и т.д.

Как можно расширить массив элементов и включить в него предыдущие записи?

Комментарии:

1. Используйте словарь или коллекцию вместо массива для хранения групп членства. И зачем вообще создавать такой большой массив для перебора?

2. Ошибка заключается в том, что вы можете использовать только Redim Preserve последний элемент многомерного массива. Поскольку вы уже arr= Range("D:F"), and your повторно выполнили инструкцию Preserve arr(…`, должно завершиться ошибкой. Это НЕ действует на массив в словаре.

3. @RonRosenfeld, что вы имеете в виду, говоря «такой большой массив»? Как бы вы разделили массив?

4. arr = Range("D:F") создает массив измерений (1 to 1048576, 1 to 4) . У вас так много элементов в вашей базе данных? Подробное обсуждение смотрите в последней статье Чипа Пирсонса о массивах и диапазонах в VBA

5. @RonRosenfeld, у меня 81.000 строк. Спасибо за ссылку. Я проверю это.

Ответ №1:

Среди других проблем:

Вы можете использовать только ReDim последний элемент многомерного массива.

Ваша строка 

 arr = sh1.Range("D:F")

создаст 2D-массив на основе 1: arr(1 to 1048576, 1 to 4) . Если у вас есть база данных с более чем 4*10^6 элементами, возможно, вы захотите рассмотреть другой инструмент.

Таким образом, допустимой командой может быть

 Redim Preserve arr(1 to ubound(arr,1), 1 to ubound(arr,2) 1)

Но это не то, что ты делаешь. Чтобы выполнить то, что вы хотите сделать, попробуйте что-то вроде этого:

 For i = LBound(arr) To UBound(arr)
    If d.Exists(arr(i, 3)) Then
        X = d(arr(i, 3))
        ReDim Preserve X(UBound(X, 1)   1)
        X(UBound(X, 1)) = arr(i, 1)
        d(arr(i, 3)) = X
    Else
        d.Add Key:=arr(i, 3), Item:=Array(arr(i, 1))
    End If    
Next i

Но почему бы просто не использовать Dictionary или Collection для хранения вашего списка элементов. Тогда вам вообще не нужно беспокоиться об изменении размера вашего массива.

Ответ №2:

Большое спасибо за вашу помощь (@Ron Rosenfeld)!

Ниже приведена моя заключительная часть кода.

 For i = LBound(arr) To UBound(arr)
    If d.Exists(arr(i, 3)) Then
        d(arr(i, 3)) = d.Item(arr(i, 3)) amp; "," amp; arr(i, 1)
    Else
        d.Add Key:=arr(i, 3), Item:=arr(i, 1)
    End If
Next i

Я все еще проверял, следует ли мне объединять строки с amp; "," amp; или с JOIN() функцией, но в конечном итоге остановился на первом варианте.

Что касается моего размера массива, я добавил счетчик строк, чтобы соответствовать длине массива. lrow = sh1.Cells(Rows.count, "D").End(xlUp).Row .