Excel VBA - уникальный список - несоответствие типа

Question

Я получаю ошибку несоответствия типа при попытке запустить этот код при открытии книги, строка, выделенная отладчиком, является второй и последней, я добавил комментарий к код, чтобы вы знали, где.

Линия, в которой есть ошибка, совпадает с строкой кода, поэтому я не уверен, почему я получаю ошибку несоответствия типа после второго цикла.

Я проверил две петли отдельно в своих собственных модулях, и он отлично работает. Это когда я объединяю их в один модуль и пытаюсь запустить при открытии книги, чтобы получить ошибку.

Private Sub Workbook_Open() 

Dim rng As Range 
Dim InputRng As Range, OutRng As Range 
Set dt = CreateObject("Scripting.Dictionary") 

Set InputRng = Worksheets("AA").Range("C2:AF366") 
Set OutRng = Worksheets("Unique Lists").Range("A2") 

For Each rng In InputRng 
    If rng.Value <> "" Then 
     dt(rng.Value) = "" 
    End If 
Next 

OutRng.Range("A1").Resize(dt.Count) = Application.WorksheetFunction.Transpose(dt.Keys) 

Application.CutCopyMode = False 

Set dt = CreateObject("Scripting.Dictionary") 
Set InputRng = Worksheets("CT").Range("C2:AF366") 
Set OutRng = Worksheets("Unique Lists").Range("B2") 

For Each rng In InputRng 
    If rng.Value <> "" Then 
     dt(rng.Value) = "" 
    End If 
Next 
'ERROR OCCURS ON THE NEXT LINE 
OutRng.Range("A1").Resize(dt.Count) = Application.WorksheetFunction.Transpose(dt.Keys) 

End Sub 

Для информации: код предназначен для создания 2 уникальных списков из диапазонов ячеек на разных листах при открытии рабочей книги.

Answer 1

Удостоверьтесь, что у вас есть данные на листе «CT». Если все ваши ячейки внутри Range("C2:AF366") не имеют значений, то dt.Count = 0 (так как ваш Dictionary пуст), и это приведет к ошибке во время выполнения.

Вы уже определены и установить OutRng, в Set OutRng = Worksheets("Unique Lists").Range("B2"), так что в вашей ошибки линии, которую вы можете использовать:

OutRng.Resize(dt.Count) = Application.WorksheetFunction.Transpose(dt.Keys) 

Answer 2

Это один из способов отладки словаря, когда вы не уверены, что у вас есть внутренняя сторонка взять посмотрите на последние строки:

Option Explicit 

Public Sub TestMe() 

    Dim rng As Range 
    Dim InputRng As Range, OutRng As Range 
    Dim dt As Object 
    Set dt = CreateObject("Scripting.Dictionary") 

    Set InputRng = Worksheets("AA").Range("C2:AF366") 
    Set OutRng = Worksheets("Unique Lists").Range("A2") 

    For Each rng In InputRng 
     If rng.Value <> "" Then 
      dt(rng.Value) = "" 
     End If 
    Next 

    OutRng.Range("A1").Resize(dt.Count) = Application.WorksheetFunction.Transpose(dt.keys) 

    Application.CutCopyMode = False 

    Set dt = CreateObject("Scripting.Dictionary") 
    Set InputRng = Worksheets("CT").Range("C2:AF366") 
    Set OutRng = Worksheets("Unique Lists").Range("B2") 

    For Each rng In InputRng 
     If rng.Value <> "" Then 
      dt(rng.Value) = "" 
     End If 
    Next 

    'ERROR OCCURS ON THE NEXT LINE 
    OutRng.Range("A1").Resize(dt.Count) = Application.WorksheetFunction.Transpose(dt.keys) 

    Dim dtKey As Variant 

    For Each dtKey In dt.keys 
     Debug.Print dtKey 
    Next dtKey 

End Sub 

в самом деле, ваш код работает вполне нормально, когда dt.Count не 0.