Excel VBA-唯一列表-类型不匹配

当我试图在打开工作簿时运行此代码时，出现类型不匹配错误，调试器高亮显示的行是倒数第二行，我已在代码中添加了注释，以便您知道位置

出现错误的那一行与前面的代码行相同，因此我不确定为什么在第二个循环之后会出现类型不匹配错误

我在各自的模块中分别测试了这两个循环，效果很好。当我将它们合并到一个模块中并尝试在打开工作簿时运行时，我得到了错误

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

Private子工作簿\u Open（）
变暗rng As范围
变暗输入范围，输出范围
Set dt=CreateObject（“Scripting.Dictionary”）
设置输入=工作表（“AA”）。范围（“C2:AF366”）
Set-OutRng=工作表（“唯一列表”）。范围（“A2”）
对于输入中的每个rng
如果rng.Value为“”，则
dt（平均值）=“”
如果结束
下一个
超出范围（“A1”）.Resize（dt.Count）=Application.WorksheetFunction.Transpose（dt.Keys）
Application.CutCopyMode=False
Set dt=CreateObject（“Scripting.Dictionary”）
设置输入=工作表（“CT”）。范围（“C2:AF366”）
Set-OutRng=工作表（“唯一列表”）。范围（“B2”）
对于输入中的每个rng
如果rng.Value为“”，则
dt（平均值）=“”
如果结束
下一个
'错误发生在下一行
超出范围（“A1”）.Resize（dt.Count）=Application.WorksheetFunction.Transpose（dt.Keys）
端接头

---

仅供参考：代码用于在打开工作簿时从不同工作表上的单元格范围创建两个唯一列表。

确保“CT”工作表中有数据。如果

范围（“C2:AF366”）

内的所有单元格都没有任何值，则

dt.Count

=0（因为

字典

为空），这将导致运行时错误

您已经在

set-OutRng=工作表（“唯一列表”）.Range（“B2”）

中定义并设置了

OutRng

，因此在错误行中可以使用：

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

---

这是调试字典的一种方法，当您不确定字典中有什么内容时，请查看最后几行：

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

选项显式
公共子TestMe（）
变暗rng As范围
变暗输入范围，输出范围
作为对象的dimdt
Set dt=CreateObject（“Scripting.Dictionary”）
设置输入=工作表（“AA”）。范围（“C2:AF366”）
Set-OutRng=工作表（“唯一列表”）。范围（“A2”）
对于输入中的每个rng
如果rng.Value为“”，则
dt（平均值）=“”
如果结束
下一个
超出范围（“A1”）.Resize（dt.Count）=Application.WorksheetFunction.Transpose（dt.keys）
Application.CutCopyMode=False
Set dt=CreateObject（“Scripting.Dictionary”）
设置输入=工作表（“CT”）。范围（“C2:AF366”）
Set-OutRng=工作表（“唯一列表”）。范围（“B2”）
对于输入中的每个rng
如果rng.Value为“”，则
dt（平均值）=“”
如果结束
下一个
'错误发生在下一行
超出范围（“A1”）.Resize（dt.Count）=Application.WorksheetFunction.Transpose（dt.keys）
Dim dtKey作为变体
对于dt.keys中的每个dtKey
调试。打印dtKey
下一个dtKey
端接头

---

事实上，当

dt.Count

不是0时，您的代码运行得很好。

您存储在第二个字典中的值是否很长（超过255个字符）？不，它们是最友好的人名-为什么不在代码顶部写

Option Explicit

，尝试编译并再次发布@PaulG有答案，第二本字典是empy。Thanks@R3uK-我尝试调试，发现它没有满，然后也看到了您的问题。