Работай всегда через строковый ключ.Будет число в ячейке,получишь индекс а не ключ.
[vba]
Код
Sub AddColor() Dim i& Dim k, ik, Key As String Set oDicColorN = CreateObject("Scripting.Dictionary") With shPart For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row Key = .Cells(i, 1).Value If Key = "" Then Key = "Пусто" End If oDicColorN.Item(Key) = .Cells(i, 1).Interior.Color
Next End With End Sub
[/vba]
Работай всегда через строковый ключ.Будет число в ячейке,получишь индекс а не ключ.
[vba]
Код
Sub AddColor() Dim i& Dim k, ik, Key As String Set oDicColorN = CreateObject("Scripting.Dictionary") With shPart For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row Key = .Cells(i, 1).Value If Key = "" Then Key = "Пусто" End If oDicColorN.Item(Key) = .Cells(i, 1).Interior.Color
Sub q() Dim lr&, i& lr = Cells(Rows.Count, 1).End(xlUp).Row If lr > 4 Then Application.ScreenUpdating = False For i = 5 To lr ' a = oDicColorN.Item(Cells(i, 3).Value) k = oDicColorN.keys it = oDicColorN.Items a = it(Cells(i, 3).Value - 1) Cells(i, 3).Interior.Color = a Next End If End Sub
[/vba]
и будет Вам ошибка Или так:
[vba]
Код
Sub q2() Dim lr&, i& lr = Cells(Rows.Count, 1).End(xlUp).Row If lr > 4 Then Application.ScreenUpdating = False For i = 5 To lr If oDicColorN.Exists(Cells(i, 3).Value) Then a = oDicColorN.Item(Cells(i, 3).Value) Else: MsgBox "Error" End If k = oDicColorN.keys it = oDicColorN.Items If oDicColorN.Exists(Cells(i, 3).Value) Then Cells(i, 3).Interior.Color = a Next End If End Sub
[/vba]
RAN, еще можно так:
[vba]
Код
Sub q() Dim lr&, i& lr = Cells(Rows.Count, 1).End(xlUp).Row If lr > 4 Then Application.ScreenUpdating = False For i = 5 To lr ' a = oDicColorN.Item(Cells(i, 3).Value) k = oDicColorN.keys it = oDicColorN.Items a = it(Cells(i, 3).Value - 1) Cells(i, 3).Interior.Color = a Next End If End Sub
[/vba]
и будет Вам ошибка Или так:
[vba]
Код
Sub q2() Dim lr&, i& lr = Cells(Rows.Count, 1).End(xlUp).Row If lr > 4 Then Application.ScreenUpdating = False For i = 5 To lr If oDicColorN.Exists(Cells(i, 3).Value) Then a = oDicColorN.Item(Cells(i, 3).Value) Else: MsgBox "Error" End If k = oDicColorN.keys it = oDicColorN.Items If oDicColorN.Exists(Cells(i, 3).Value) Then Cells(i, 3).Interior.Color = a Next End If End Sub
Судя по всему, это не шибко декларируемый метод заполнения словаря... Надо бы запомнить. И намотать на хвост, что без проверки наличия, извлекать значения словаря нельзя.
Судя по всему, это не шибко декларируемый метод заполнения словаря... Надо бы запомнить. И намотать на хвост, что без проверки наличия, извлекать значения словаря нельзя.RAN
потому, что добавление несуществующего элемента происходит в свойстве Get Item, примерно так: [vba]
Код
Public Property Get Item(KeyOrIndex) On Error GoTo ErrHandler Item = colItems(KeyOrIndex) Exit Property ErrHandler: colItems.Add Empty, CStr(KeyOrIndex) End Property
[/vba] т.е. с "лишними" проверками при написании словаря не заморачивались...
Не получит элемент по индексу (это не коллекция), получит еще один пустой элемент с числовым ключом (проверьте). [vba]
Код
Sub Test() Dim v, dic As Object Set dic = CreateObject("Scripting.Dictionary")
v = dic("Key1") ' будет добавлен элемент с ключом "Key1" dic("Key2") = 27 ' будет добавлен элемент с ключом "Key2" dic("Key3") = dic("Key4") ' будyт добавлены элементы с ключами "Key4" и "Key3" (именно в такой последовательности) v = dic(1) ' будет добавлен 5-й элемент, с ключом 1 v = dic("1") ' будет добавлен 6-й элемент, с ключом "1" End Sub
потому, что добавление несуществующего элемента происходит в свойстве Get Item, примерно так: [vba]
Код
Public Property Get Item(KeyOrIndex) On Error GoTo ErrHandler Item = colItems(KeyOrIndex) Exit Property ErrHandler: colItems.Add Empty, CStr(KeyOrIndex) End Property
[/vba] т.е. с "лишними" проверками при написании словаря не заморачивались...
Не получит элемент по индексу (это не коллекция), получит еще один пустой элемент с числовым ключом (проверьте). [vba]
Код
Sub Test() Dim v, dic As Object Set dic = CreateObject("Scripting.Dictionary")
v = dic("Key1") ' будет добавлен элемент с ключом "Key1" dic("Key2") = 27 ' будет добавлен элемент с ключом "Key2" dic("Key3") = dic("Key4") ' будyт добавлены элементы с ключами "Key4" и "Key3" (именно в такой последовательности) v = dic(1) ' будет добавлен 5-й элемент, с ключом 1 v = dic("1") ' будет добавлен 6-й элемент, с ключом "1" End Sub