EXCEL VBA：運行時錯誤“13”類型不匹配：列表框

Question

我從這位先生那里看到了一個很棒的教程： https : //www.businessprogrammer.com/how-to-use-listbox-in-excel-vba-userform/但是如果我只制作 1 個數據行，我會收到一個錯誤：輸入錯配。 你能幫我為什么會出現這個錯誤嗎，即使我有 x 行但城市名稱相同，我也會收到這個錯誤....奇怪

它是關於這里的代碼部分（例如，listbox1 根據選擇的 listbox2 列表給出。但如果只找到 1 個 kina 數據，我會收到此錯誤）：

Option Explicit

Private Sub UserForm_Initialize()
    Dim Hauptkategorie() As Variant
    
    Me.Caption = "Artikelsuche"
    ClearFilter
    
    ' Get array of cities and apply to listbox
    Hauptkategorie = GetHauptkategorieList()
    ListBox1.List = Hauptkategorie
    
    'LoadAllDataToDataList

End Sub

' Return list of Hauptkategorie
Private Function GetHauptkategorieList() As Variant
    Dim rngData As Range, rngCrit As Range, rngExt As Range
    Dim vReturn As Variant
    Dim i As Integer
    
    Set rngData = ArtikelDatasource.Range("A1").CurrentRegion
    Set rngCrit = CategoryCriteria.Range("B1:B2")
    Set rngExt = CategoryCriteria.Range("B6")
    rngData.AdvancedFilter xlFilterCopy, rngCrit, rngExt, True
    Set rngExt = rngExt.CurrentRegion
    
    ' Sort the cities ascending
    rngExt.Sort Key1:=rngExt.Resize(1, 1), Header:=xlYes, Order1:=xlAscending
    
    If rngExt.Rows.Count > 1 Then
        vReturn = rngExt.Resize(rngExt.Rows.Count - 1).Offset(1)
    Else
        'Use this to return "no data" message
        vReturn = noDataArray()
    End If
    GetHauptkategorieList = vReturn
        
        For i = 2 To 8
        With ArtikelSuche
        .Controls("Listbox" & i).Clear
        End With
        Next i
    
End Function

Private Sub ListBox1_Change()
    Dim rngData As Range, rngCrit As Range, rngExt As Range
    Dim Ebene1kategorie() As Variant
    
    CategoryCriteria.Range("C2").ClearContents
    CategoryCriteria.Range("E2").ClearContents
    CategoryCriteria.Range("G2").ClearContents
    CategoryCriteria.Range("I2").ClearContents
    CategoryCriteria.Range("K2").ClearContents
    CategoryCriteria.Range("M2").ClearContents
    CategoryCriteria.Range("O2").ClearContents
    
    If ListBox1.ListIndex = -1 Then Exit Sub   ' nothing is selected, so quit
    Debug.Print ListBox1.List(ListBox1.ListIndex)

    CategoryCriteria.Range("A2").Value = ListBox1.List(ListBox1.ListIndex)
    Set rngData = ArtikelDatasource.Range("A1").CurrentRegion
    Set rngCrit = CategoryCriteria.Range("A1").CurrentRegion
    Set rngExt = ArticleCriteria.Range("A6").CurrentRegion.Resize(1)
    rngData.AdvancedFilter xlFilterCopy, rngCrit, rngExt
    Set rngData = rngExt.CurrentRegion
    If rngData.Rows.Count > 1 Then
       Set rngData = rngData.Resize(rngData.Rows.Count - 1).Offset(1)
       'ListBox2.RowSource = "'" & rngData.Parent.Name & "'!" & rngData.Address
    Else
        Debug.Print "Error, No data for given list item, which is kinda strange...."
        Exit Sub
    End If
    'ListBox2.Clear
    Ebene1kategorie = GetEbene1List()
    ListBox2.List = Ebene1kategorie
    ListBox2.ListIndex = -1
End Sub

Private Function GetEbene1List() As Variant
    Dim rngData As Range, rngCrit As Range, rngExt As Range
    Dim vReturn As Variant
    Dim i As Integer
    
    Set rngData = ArticleCriteria.Range("A6").CurrentRegion
    Set rngCrit = CategoryCriteria.Range("d1:d2")
    Set rngExt = CategoryCriteria.Range("d6")
    rngData.AdvancedFilter xlFilterCopy, rngCrit, rngExt, True
    Set rngExt = rngExt.CurrentRegion
    
    ' Sort the cities ascending
    rngExt.Sort Key1:=rngExt.Resize(1, 1), Header:=xlYes, Order1:=xlAscending
    
    If rngExt.Rows.Count > 1 Then
        vReturn = rngExt.Resize(rngExt.Rows.Count - 1).Offset(1)
    Else
        ' Use this to return "no data" message
        vReturn = noDataArray()
    End If
    GetEbene1List = vReturn
    
        For i = 3 To 8
        With ArtikelSuche
        .Controls("Listbox" & i).Clear
        End With
    Next i
    
End Function

Private Sub ListBox2_Change()
    Dim rngData As Range, rngCrit As Range, rngExt As Range
    Dim Ebene2kategorie() As Variant
    
    CategoryCriteria.Range("E2").ClearContents
    CategoryCriteria.Range("G2").ClearContents
    CategoryCriteria.Range("I2").ClearContents
    CategoryCriteria.Range("K2").ClearContents
    CategoryCriteria.Range("M2").ClearContents
    CategoryCriteria.Range("O2").ClearContents

    If ListBox2.ListIndex = -1 Then Exit Sub   ' nothing is selected, so quit
    Debug.Print ListBox2.List(ListBox2.ListIndex)

    CategoryCriteria.Range("c2").Value = ListBox2.List(ListBox2.ListIndex)
    Set rngData = ArtikelDatasource.Range("A1").CurrentRegion
    Set rngCrit = CategoryCriteria.Range("A1").CurrentRegion
    Set rngExt = ArticleCriteria.Range("A6").CurrentRegion.Resize(1)
    rngData.AdvancedFilter xlFilterCopy, rngCrit, rngExt
    Set rngData = rngExt.CurrentRegion
    
    If rngData.Rows.Count > 1 Then
    
    'If rngExt.Rows.Count < 3 Then
    
       'Set rngData = rngData.Resize(rngData.Rows.Count - 0).Offset(1)
       'ListBox2.RowSource = "'" & rngData.Parent.Name & "'!" & rngData.Address
       
       'Else
       Set rngData = rngData.Resize(rngData.Rows.Count - 1).Offset(1)
       'End If
       
    Else

        Debug.Print "Error, No data for given list item, which is kinda strange...."
        Exit Sub
    End If
    'ListBox2.Clear
    Ebene2kategorie = GetEbene2List()
    ListBox3.List = Ebene2kategorie
    ListBox3.ListIndex = -1
End Sub

Private Function GetEbene2List() As Variant
    Dim rngData As Range, rngCrit As Range, rngExt As Range
    Dim vReturn As Variant
    Dim i As Integer
    
    Set rngData = ArticleCriteria.Range("A6").CurrentRegion
    Set rngCrit = CategoryCriteria.Range("f1:f2")
    Set rngExt = CategoryCriteria.Range("f6")
    rngData.AdvancedFilter xlFilterCopy, rngCrit, rngExt, True
    Set rngExt = rngExt.CurrentRegion
    
    ' Sort the cities ascending
    rngExt.Sort Key1:=rngExt.Resize(1, 1), Header:=xlYes, Order1:=xlAscending
    
    If rngExt.Rows.Count > 1 Then
        'If rngExt.Rows.Count < 3 Then
       ' vReturn = rngExt.Resize(rngExt.Rows.Count - 0).Offset(1)
       ' Else
        vReturn = rngExt.Resize(rngExt.Rows.Count - 1).Offset(1)
       ' End If
    Else
    
        ' Use this to return "no data" message
        vReturn = noDataArray()
    End If
    GetEbene2List = vReturn
    
        For i = 4 To 8
        With ArtikelSuche
        .Controls("Listbox" & i).Clear
        End With
        Next i
    
End Function

（並且代碼更進一步：列表框都是以這種方式完成的）

Answer 1

當您將區域的值分配給變體時，如果該區域包含單個單元格，Excel 將創建一個字符串或數值，或者如果該區域中有多個單元格，則創建一個數組。 試試這個測試：-

Private Sub TestArray()
    ' 271

    Dim Arr1            As Variant
    Dim Arr2            As Variant
    
    With ActiveSheet
        Arr1 = .Range(.Cells(1, 1), .Cells(1, 1)).Value
        Arr2 = .Range(.Cells(1, 1), .Cells(2, 1)).Value
    End With
    
    Debug.Print VarType(Arr1), VarType(Arr2)
End Sub

VarType(Arr1)將返回 5 或 8（數字或字符串），具體取決於單元格 A1 包含的內容，以及Arr2 的8204。 任何低於 8200 的數字表示該變體不是對象。 Debug.Print Arr1(1, 1)將返回錯誤，因為 Arr1 不是數組。

在下面的程序中合並了上述測試。 如果過濾器返回單個項目並且vReturn因此不是數組，則代碼會將值轉換為數組並將單個值分配給它。 因此， vReturn(1, 1)不會像省略這種處理時那樣拋出錯誤。

Private Function GetEbeneList(ByVal Clm As Long) As Variant
    ' 271
    ' Clm = 4 (column D) or 6 (column F)
    
    Dim vReturn As Variant
    Dim Tmp     As Variant
    Dim rngData As Range, rngCrit As Range, rngExt As Range
    Dim i       As Integer

    Set rngData = ArticleCriteria.Range("A6").CurrentRegion
    With CategoryCriteria
        Set rngCrit = .Range(.Cells(1, Clm), .Cells(2, Clm))
        Set rngExt = .Cells(6, Clm)
    End With
    
    rngData.AdvancedFilter xlFilterCopy, rngCrit, rngExt, True
    With rngExt.CurrentRegion
        If .Rows.Count > 1 Then
            ' Sort the cities ascending
            .Sort Key1:=.Resize(1, 1), Header:=xlYes, Order1:=xlAscending
            vReturn = .Resize(.Rows.Count - 1).Offset(1).Value
        Else
            ' Use this to return "no data" message
            vReturn = noDataArray()
        End If
    End With

    If VarType(vReturn) < 8200 Then
        Tmp = vReturn
        ReDim vReturn(1 To 1)
        vReturn(1, 1) = Tmp
    End If
    GetEbeneList = vReturn
    
    For i = 3 To 8
        ArtikelSuche.Controls("Listbox" & i).Clear
    Next i
End Function

該代碼未經測試（最后，並非最不重要，因為我沒有您的函數NoDataArra() ），因此可能包含我道歉的錯誤。 為了彌補，我做了一些改變。

基本上，您的函數GetEbene1List和GetEbene2List除了它們引用的列之外是相同的。 與其創建 2 個函數，不如創建一個並提供列變量作為參數。 這個想法被合並在上面。

所以，而不是你現有的函數調用......

Ebene1kategorie = GetEbene1List()
ListBox2.List = Ebene1kategorie
ListBox2.ListIndex = -1

你現在應該打電話...

With ListBox2
    .List = EbeneKategorie(4)
    .ListIndex = -1
End With

代碼中有更多不需要解釋的語法變化。 它們只是為輸入錯誤和邏輯錯誤提供了更多機會:-)

Answer 2

非常感謝您為我的問題投入時間。 我真的不得不來這個小組詢問專業人士，因為我被困住了，我會非常誠實：我真的有非常基本的編程概念。 我也做 Arduino、joomla 等，但都是業余愛好。 我的目標實際上是從 A:X 列中獲得一堆數據（作為示例），並擁有一個帶有 X 列表框的用戶表單。 第一個列表框的作用是，它實際上檢查 A 列中的所有值，並且只顯示那些彼此不同的值，假設您有 400 行，只有 3 個不同的值，因此在這種情況下，列表框 1 有 3 行。 如果單擊 Listbox1 中的一行，則 Columne B 將根據 Listbox1 中選擇的內容進行檢查，因此在這種情況下，Columne A 和 Listbox 2 僅顯示下一個值，依此類推...

這樣你就可以擁有一個很酷的搜索系統。 我發現這個紳士的想法很酷，所以我今天下班回家解決了它。

我以一種笨拙的方式解決了它，但它有效。 我也會嘗試您的解決方案。

我就是這樣做的 :(（只向您展示 1 個列表框和函數）。是的，我使用了錯誤句柄。讓我知道您對此解決方案的看法 :)

親切的問候

Private Sub ListBox2_Change()

Dim rngData As Range, rngCrit As Range, rngExt As Range
Dim Ebene2kategorie() As Variant
Dim Ebene2kategorie2(1 To 1, 1 To 1) As Variant

CategoryCriteria.Range("E2").ClearContents
CategoryCriteria.Range("G2").ClearContents
CategoryCriteria.Range("I2").ClearContents
CategoryCriteria.Range("K2").ClearContents
CategoryCriteria.Range("M2").ClearContents
CategoryCriteria.Range("O2").ClearContents

If ListBox2.ListIndex = -1 Then Exit Sub   ' nothing is selected, so quit
Debug.Print ListBox2.List(ListBox2.ListIndex)

CategoryCriteria.Range("c2").Value = ListBox2.List(ListBox2.ListIndex)
Set rngData = ArtikelDatasource.Range("A1").CurrentRegion
Set rngCrit = CategoryCriteria.Range("A1").CurrentRegion
Set rngExt = ArticleCriteria.Range("A6").CurrentRegion.Resize(1)
rngData.AdvancedFilter xlFilterCopy, rngCrit, rngExt
Set rngData = rngExt.CurrentRegion

If rngData.Rows.Count > 1 Then

   Set rngData = rngData.Resize(rngData.Rows.Count - 1).Offset(1)
   
Else

    Debug.Print "Error, No data for given list item, which is kinda strange...."
    Exit Sub
End If

On Error GoTo zero

    Ebene2kategorie() = GetEbene2List()
    ListBox3.List = Ebene2kategorie
    ListBox3.ListIndex = -1
    Exit Sub

zero:
    Ebene2kategorie2(1, 1) = GetEbene2List()
    ListBox3.List = Ebene2kategorie2

On Error GoTo 0

ListBox3.ListIndex = -1

End Sub

…

Private Function GetEbene2List() As Variant

Dim rngData As Range, rngCrit As Range, rngExt As Range

Dim vReturn2(1 To 1, 1 To 1) As Variant
Dim vReturn As Variant
    
Dim i As Integer

Set rngData = ArticleCriteria.Range("A6").CurrentRegion
Set rngCrit = CategoryCriteria.Range("f1:f2")
Set rngExt = CategoryCriteria.Range("f6")
rngData.AdvancedFilter xlFilterCopy, rngCrit, rngExt, True
Set rngExt = rngExt.CurrentRegion

' Sort the cities ascending
rngExt.Sort Key1:=rngExt.Resize(1, 1), Header:=xlYes, Order1:=xlAscending

If rngExt.Rows.Count > 1 And rngExt.Rows.Count < 3 Then

    vReturn2(1, 1) = rngExt.Resize(rngExt.Rows.Count - 1).Offset(1)
    GetEbene2List = vReturn2(1, 1)

ElseIf rngExt.Rows.Count > 1 Then

    vReturn = rngExt.Resize(rngExt.Rows.Count - 1).Offset(1)
    GetEbene2List = vReturn
        
Else
    ' Use this to return "no data" message

    vReturn2(1, 1) = noDataArray()

End If

    For i = 4 To 8
    With ArtikelSuche
    .Controls("Listbox" & i).Clear
    End With
    Next i

End Function