Excel - странное поведение объекта словаря

Question

У меня возникли проблемы со следующей строки кода:

Set DICT = RowMap(Range(Workbooks("A").Sheets(1).Cells(ITEM_NO_ROW, _ 
ITEM_NO_COLUMN), Workbooks("A").Sheets(1).Cells(ITEM_NO_ROW + 1, ITEM_NO_COLUMN).End(xlDown))) 

Этот код вызывает RowMap. Я поставил перерыв в «Конечной функции» RowMap и проверил количество rv и RowMap в окне просмотра. Оба показателя - 84, как и должно быть. Однако, как только я нажму F8, который приведет меня к основной рутине, и проверьте количество DICT, это 85, а не 84.

Не должно ли DICT быть точно таким же, как RowMap или rv? Почему количество DICT увеличивается на 1? Какая строка кода делает это? Я полностью потерян.

Я не знаю, помогла бы эта информация или нет. Вышеуказанная строка набора DICT завернута в цикл «Для каждой ячейки в rng», и это ячейка, добавленная в конец DICT.

Любая помощь будет принята с благодарностью.

Function RowMap(rng1 As Range) As Object 
'store item no and price in dictionary 

    Dim rv As Object 
    Dim c As Range 
    Dim v As long 
    On Error Resume Next 

    Set rv = Nothing 

    Set rv = CreateObject("scripting.dictionary") 
    For Each c In rng1.Cells 
     v = c.Value 
     If Not rv.Exists(v) Then 
      rv.Add v, c.Offset(0, 4) 'add item no and price 
     Else 
      MsgBox "Duplicate value detected in " & Book_Name & "!" 
      Exit For 
     End If 
     Next c 

    Set RowMap = rv 

End Function 

---

For Each wk In Application.Workbooks 

    If Left(wk.Name, 6) = "All FE" Then 

     ERROR_Sheet_No = ERROR_Sheet_No + 1 

     For Each sh In wk.Sheets 

      Set Report_Last_Cell = sh.Cells(5000, 3).End(xlUp) 

      'sort the data by group code 
      Set rng = sh.Range(sh.Cells(4, 1), Report_Last_Cell.Offset(0, 4)) 

      rng.Sort key1:=sh.Cells(4, 4), order1:=xlAscending, Header:=xlNo 

      Set rng = sh.Range(sh.Cells(4, 3), Report_Last_Cell) 

      For Each cell In rng 
       If cell.Value <> "LAVENDER" And cell.Value <> "CLOSED" And cell.Value <> "VOID" And cell.Value <> "NO SALE" And _ 
        InStr(cell.Value, "DISCOUNT") = 0 And InStr(cell.Value, "DEPOSIT") = 0 And Len(cell) <> 0 Then 

        Group_Code = cell.Offset(0, 1).Value 

        If Group_Code <> Old_Group_Code Then 'open the PHOTO_QUOTE file 
         'close the old PHOTO_QUOTE file first 
         On Error Resume Next 
         Workbooks(File_Prefix & Old_Group_Code & ".xlsx").Close 
         On Error GoTo 0 

         'open the PHOTO QUOTE file if exists 
         If Len(Dir(Flower_Path & File_Prefix & Group_Code & ".xlsx")) <> 0 Then 'if file is found 
          Workbooks.Open Flower_Path & File_Prefix & Group_Code & ".xlsx" 

          Photo_Quote_Book_Name = File_Prefix & Group_Code & ".xlsx" 
          On Error Resume Next 
          DICT.RemoveAll 
          Set DICT = Nothing 

          Set DICT = RowMap(Range(Workbooks(Photo_Quote_Book_Name).Sheets(1).Cells(PHOTO_QUOTE_ITEM_NO_ROW, _ 
           PHOTO_QUOTE_ITEM_NO_COLUMN), Workbooks(Photo_Quote_Book_Name).Sheets(1).Cells(PHOTO_QUOTE_ITEM_NO_ROW + 1, PHOTO_QUOTE_ITEM_NO_COLUMN).End(xlDown))) 
          On Error GoTo 0 

          'check if ITEM NO exists 
          If Not DICT.Exists(cell.Value) Then 
           Copy_to_ERROR_sheet sh.Name, ERROR_Sheet_lastrow, 0, 0, 255 


          'check if price matches 
          ElseIf cell.Offset(0, 3).Value <> DICT(cell.Value) Then 
           Copy_to_ERROR_sheet sh.Name, ERROR_Sheet_lastrow, 0, 255, 0 
          End If 


         Else 'if the PHOTO_QUOTE file doesn't exist, copy shop, date, voucher no, item no, price to 
         ' ERROR_BOOK_NAME and change color to red 

          Copy_to_ERROR_sheet sh.Name, ERROR_Sheet_lastrow, 255, 0, 0 
         End If 'If Len(Dir(Flower_Path & File_Prefix & Group_Code & ".xlsx")) <> 0 Then 

         Old_Group_Code = Group_Code 
        End If ' If Group_Code <> Old_Group_Code Then 


       End If 'If cell.Value <> "LAVENDER" And cell.Value <> "CLOSED" And cell.Value <> "VOID" And cell.Value <> "NO SALE" And _ 
       InStr(cell.Value, "DISCOUNT") = 0 And InStr(cell.Value, "DEPOSIT") = 0 And Len(cell) <> 0 Then 

      Next 'For Each cell In rng 


     Next 'For Each sh In wk 

    End If 'If Left(wk.Name, 6) = "All FE" Then 

Next 'For Each wk In Application.Workbooks 

Close_PHOTO 

Application.Calculation = xlCalculationAutomatic 
Application.ScreenUpdating = True 

End Sub 'Check_Price 

Answer 1

Вот пример того, что может произойти, если вы не будете осторожны с использованием окна «Часы» при работе с Словарем.

Введите этот код в модуль и установить перерыв и два часы, как указано:

Sub Tester() 

    Dim dict As Object 
    Set dict = CreateObject("scripting.dictionary") 

    dict.Add "A", 1 
    dict.Add "B", 2 
    dict.Add "C", 3 '<<< put a break here 
    dict.Add "D", 4 

    Debug.Print dict("D") '<< put a watch on `dict("D")` 
    Debug.Print dict.Count '<< put a watch on `dict` 

End Sub 

Теперь бегите к обрыву и проверить окно Watch - несмотря на то, что ваш код все еще ждет на перерыв (и ключ «C» еще не добавлен), ваш словарь уже имеет пустой слот «D» (и счетчик , а не 2).

Даже если вы удалите dict.Add "D", 4 из вашего кода, часы на dict("D") останется в окне Watch (если вы активно не удалите его), и будет держать, добавив, что «лишние» ключ ...

Answer 2

Не могу пока комментировать, поскольку я не хватает репутации:

Я думаю, что я видел это раньше, и подозреваю, что это является результатом отладки. Вы пробовали выводить (например, msgbox) RowMap.Countпосле вызов функции, а не проверку во время отладки, чтобы узнать, что вы получаете?