Excel VBA – 唯一列表 – types不匹配

当我尝试在打开工作簿时运行此代码时，出现types不匹配错误，debugging器突出显示的行是第二行，我已经向代码添加了注释，以便您知道位置。

出现错误的行与进一步的代码行相同，所以我不确定为什么在第二个循环之后出现types不匹配的错误。

我已经在他们自己的模块中分别testing了两个循环，并且工作正常。 这是当我把它们合并成一个模块，并试图运行打开工作簿，我得到的错误。

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 

有关信息：代码被devise为在打开工作簿时从不同工作表上的单元格范围创build2个唯一列表。

Answer 1

确保你的“CT”工作表中有数据 。 如果Range("C2:AF366")所有单元格都没有任何值，则dt.Count = 0（因为Dictionary为空），这将导致运行时错误。

您已经在Set OutRng = Worksheets("Unique Lists").Range("B2")定义并设置了OutRng ，因此在您的错误行中可以使用：

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

Answer 2

这是debugging字典的一种方法，当你不确定你在里面有什么时，看看最后一行：

 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时，你的代码工作得很好。