Question

当我尝试在打开工作簿时运行此代码时出现类型不匹配错误，调试器突出显示的行是倒数第二个，我在代码中添加了注释，以便您知道在哪里。< / p>

出现错误的行与进一步向上的行相同，所以我不确定为什么在第二次循环后出现类型不匹配错误。

我已经在他们自己的模块中分别测试了两个循环，它工作正常。当我将它们组合成1个模块并尝试运行打开工作簿时，我得到了错误。

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

确保您的＆＃34; CT＆＃34;工作表即可。如果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时，您的代码工作正常。

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

2 个答案: