Словарь значения ключа из другого массива

Question

Ответ на этот вопрос ... приходится ждать 2 дня, чтобы принять собственный ответ

---

Справочная информация:

У меня естьмассив ("arr"), сгенерированный из набора данных в Excel;Я использую этот массив для заполнения другого массива ("zrr"), где одним из аспектов этой популяции является использование словаря ("dcdept").

Словарь был заполнен надлежащим образом (проверено с помощью debug.print dcdept(ActualKey); былозаполненный таким образом, что dcdept(4000)="Value" и протестированный debug.print dcdept(4000) напечатали слово «Значение» в ближайшем окне.

Первоначально я использовал исходный набор данных через .cells(i,) ссылок, но я попытался с несколькими сотнями тысяч строксохранить активность в VBA для ускорения.

Нет ошибок / предупреждений, генерируемых из моего кода.

---

Проблема:

При попытке заполнить элемент в zrr (zrr(i-1,3)), используя ключ словаря от arr (dcdept(arr(i-2,16))), я не получаю никакого значения.

---

Вопрос:

Есть ли у кого-нибудь какие-либо предложения / решения по решению проблемы с указанными данными?

---

Код вопроса:

Public arr As Variant, brr As Variant, crr As Variant, drr As Variant, lrs As Long
Private Sub changes()
    Dim i As Long, x As Long, y As String, z As String, dcdept As Scripting.Dictionary, zrr As Variant, a As Long
    'set-up dictionary for department
    Set dcdept = New Scripting.Dictionary
    dcdept(4000) = "Value"
    'generate array to store new values
    With Sheets("Conversion")
        .Columns(16).NumberFormat = "0"
        lrs = .Cells(.Rows.Count, 1).End(xlUp).Row
        arr = .Range(.Cells(2, 1), .Cells(lrs, 17)).Value '17 = Q
        ReDim zrr(lrs, 4)
        For i = 2 To lrs
            ReDim Preserve zrr(lrs, 4)
            Select Case Left(arr(i - 1, 17), 3)
                Case "QTE"
                    x = 7
                Case "ZNA"
                    x = 5
            End Select
            zrr(i - 2, 0) = Right(arr(i - 1, 17), x)
            If InStr(arr(i - 1, 9), " Milestone ") Then
                y = Left(arr(i - 1, 9), 2) & " " & arr(i - 1, 10)
            Else
                y = arr(i - 1, 9) & " " & arr(i - 1, 10)
            End If
            zrr(i - 2, 1) = y
            If IsEmpty(arr(i - 1, 14)) Then
                zrr(i - 2, 2) = "N"
            Else
                zrr(i - 2, 2) = "Y"
            End If
            a = Val(arr(i - 1, 16))
            z = dcdept(a)
            zrr(i - 2, 3) = z
            Debug.Print a
            Debug.Print z
        Next i
        'append data to sheet
        .Cells(2, "R").Resize(lrs, 3).Value = zrr  'SHOULD BE Resize(lrs,4), per answer
    End With
End Sub

Answer 1

Я идиот ...

.Cells(2, "R").Resize(lrs, 3).Value = zrr 

должно быть

.Cells(2, "R").Resize(lrs, 4).Value = zrr

---

Не могу принять мой собственный ответ в течение 2 дней; простите за вопрос без ответа.

Answer 2

ОК, это не ответ, а иллюстрация моего комментария.Я не ожидал, что это произойдет.Я настроил простой сценарий, который, я надеюсь, похож на ваш:

Sub x()

Dim oDic As Object, v1(1 To 2), v2(1 To 2), v, i As Long

Set oDic = CreateObject("Scripting.Dictionary")

v1(1) = "Fred"
v1(2) = 1000

oDic(1) = v1(1) 'key 1, item "Fred
oDic(2) = v1(2) 'key 2, item 1000

Окно местных жителей после этого выглядит так:

---

Затем добавьте эту строку

v2(1) = oDic(v1(1))

, и в ближайшем окне появится следующее сообщение:

---

Добавитьэта строка

v2(2) = oDic(v1(2))

и в ближайшем окне читается так: