在第二个循环中将列分配给数组时，VBA类型不匹配

如何解决在第二个循环中将列分配给数组时，VBA类型不匹配

与本主题一样，我有问题。下面的代码在For Each key In dict.Keys的第一个循环上工作正常，但是在运行该行时出现类型不匹配错误：

data2 = DataSheet.UsedRange.Columns(6).SpecialCells(xlCellTypeVisible).Value

在此之前，我曾尝试擦除data2数组，但是它不起作用。

编辑：该代码从一列中获取唯一条目，过滤每个条目并从其旁边的列（经过过滤）中获取唯一条目，以及一些其他数据。

这是完整的代码：

Sub CollectData() '(Database,DataSheet,rN,rP)

Dim data() As Variant,dict As Object,r As Long,key As Variant
Dim data2() As Variant,dict2 As Object,r2 As Long,key2 As Variant,data3()
Dim ws1 As Worksheet,ws2 As Worksheet,RanTable As Range,endRow As Long
Dim Rang1 As Range
Dim ELRCount As Long,TIDCount As Long

Set Database = ActiveWorkbook.Sheets("ELRDatabase")
Set DataSheet = ActiveWorkbook.Sheets("Sheet1")
Set dict = CreateObject("Scripting.Dictionary")

data = DataSheet.UsedRange.Columns(5).Value

For r = 2 To UBound(data)
    dict(data(r,1)) = Empty
Next

'Select Full Table

endRow = DataSheet.Range("A2").End(xlDown).Row
Set RanTable = DataSheet.Range("$A$1:$AQ$" & endRow)

With DataSheet.Sort
    .SortFields.Clear
    .SortFields.Add key:=RanTable(1,7),Order:=xlAscending
    .SortFields.Add key:=RanTable(1,8),Order:=xlAscending
    .SetRange RanTable
    .Header = xlYes
    .Apply
End With

For Each key In dict.Keys

    DataSheet.AutoFilterMode = False
    RanTable.AutoFilter Field:=5,Criteria1:=key
    Set dict2 = CreateObject("Scripting.Dictionary")

    data2 = DataSheet.UsedRange.Columns(6).SpecialCells(xlCellTypeVisible).Value

    For r2 = 2 To UBound(data2)
        dict2(data2(r2,1)) = Empty
    Next

    For Each key2 In dict2.Keys

        If Database.Range("A2") = "" Then
            Set Rang1 = Database.Range("A2")
        Else
            Set Rang1 = Database.Range("A1").End(xlDown).Offset(1,0)
        End If

        data3 = DataSheet.Range("G:K").SpecialCells(xlCellTypeVisible).Value

        Rang1.Value = "rN"
        Rang1.Offset(0,1).Value = key
        Rang1.Offset(0,2).Value = key2
        Rang1.Offset(0,3).Value = RanTable(2,16)
        Rang1.Offset(0,4).Value = data3(2,1)
        Rang1.Offset(0,5).Value = data3(2,2)
        Rang1.Offset(0,6).Value = data3(UBound(data3),4)
        Rang1.Offset(0,7).Value = data3(UBound(data3),5)
        Rang1.Offset(0,8).Value = "rP"

    Next key2

Next key

End Sub

解决方法

不连续

未经测试！

data2解决方案可能类似于以下内容：

Option Explicit

Sub CollectData()
    
    '...
    Set dict2 = CreateObject("Scripting.Dictionary")
    
    ' Instead of 'Data2 = DataSheet.UsedRange...' use the following:
    Dim rng As Range: Set rng = Datasheet.UsedRange.Columns(6)
    Call getVisibleColumn(Data2,rng)
     
    ' or just (without 'rng'):
    'Call getVisibleColumn(Data2,Datasheet.UsedRange.Columns(6))
     
    ' and continue with:
    For r2 = 2 To UBound(Data2)
        dict2(Data2(r2,1)) = Empty
    Next
    '...

End Sub

Sub getVisibleColumn(ByRef Data As Variant,ColumnRange As Range)
    
    Dim rng As Range: Set rng = ColumnRange.SpecialCells(xlCellTypeVisible)
    
    ReDim Data(1 To rng.Cells.Count,1 To 1)
    
    Dim cel As Range,i As Long
    For Each cel In rng.Cells
        i = i + 1: Data(i,1) = cel.Value
    Next cel

End Sub

可以使用类似（更复杂）的方法来获得data3解决方案。