我的 (Vba) 代码仅适用于列表中的 1 个变量,并且在列表框中使用多个变量时仅返回空白

My (Vba) Code only works with 1 variable in the list, and gives only blanks back when multiple variables used in listbox

我有一个代码可以将我的 Excel 文件(行 = 12,5k+ 和列 = 97)的所有数据放入一个二维字符串中。然后它循环遍历特定列 ("G") 以列出仅包含唯一发现的列表框 ("listbox1")。 然后在用户窗体中,用户可以选择 select 一些找到的项目并将其转换为另一个列表框("Listbox2")然后当用户点击按钮(CommandButton4)时,我希望代码能够过滤仅在第 "G" 列中与 listbox2 中的一个(或多个)给定条件相同的行上排列。 它在列表框中只有一项时有效,但是当列表框中有两项时,它只有 returns 一切都是空白的。

谁能告诉我我做错了什么,因为我不知道。

代码:

Private Sub CommandButton4_Click()
    Dim arr2() As Variant
    Dim data As Variant
    Dim B_List As Boolean
    Dim i As Long, j As Long, q As Long, r As Long, LastColumn  As Long, LastRow As Long
    q = 1
    r = 1

    Dim ws As Worksheet
    Set ws = ActiveWorkbook.Sheets("Sheet3")
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    With ThisWorkbook.Sheets("Sheet3")
        LastRow = .Cells(Rows.Count, 2).End(xlUp).Row
        LastColumn = .Cells(3, Columns.Count).End(xlToLeft).Column
        ReDim arr2(1 To LastRow, 1 To LastColumn)

        For i = 2 To LastRow
            For j = 1 To LastColumn
                arr2(i, j) = .Cells(i, j).Value
            Next j
        Next i
    End With

    For i = 1 To LastRow
        For j = 0 To Me.ListBox2.ListCount - 1
            If ListBox2.List(j) = arr2(i, 7) Then
                'Later aan te passen
            Else
                For q = 1 To LastColumn
                    arr2(i, q) = ""
                Next q
            End If
        Next j
    Next i

    Sheets("Sheet3").UsedRange.ClearContents

    For i = LBound(arr2, 1) To UBound(arr2, 1)
        If arr2(i, 2) <> "" Then
            r = r + 1
            For j = LBound(arr2, 2) To UBound(arr2, 2)
                ThisWorkbook.Sheets("Sheet3").Cells(r, j).Value = arr2(i, j)

            Next j
        End If
        Debug.Print i, j, arr2(i, 7)
    Next i

    Application.ScreenUpdating = True
    Application.EnableEvents = True

End Sub

问题是你的第二个 nested-loop:

For i = 1 To LastRow
    For j = 0 To Me.ListBox2.ListCount - 1
        If ListBox2.List(j) = arr2(i, 7) Then
            'Later aan te passen
        Else
            For q = 1 To LastColumn
                arr2(i, q) = ""
            Next q
        End If
    Next j
Next i

假设我们的 ListBox 有 2 个值,“First”和“Second”。对于每一行,您执行以下操作:

j = 0

ListBox2.List(0) = "First"

If Column G is "First", do nothing

Otherwise, make the whole Row Blank Including if Column G = "Second"

At this point, the only possible values for Column G are now "First" or Blank

j = 1

ListBox2.List(1) = "Second"

If Column G is "Second", do nothing But, this cannot happen, because you have already changed any "Second" Rows to Blank

Otherwise, make the whole Row Blank

At this point, the Row will always be Blank

我建议使用布尔测试变量。在每个 Row-loop 的开头将其设置为 False,如果找到匹配项,则将其设置为 True。如果检查所有 ListBox 项目后 仍然 False然后 空白行:

Dim bTest AS Boolean
For i = 1 To LastRow
    bTest = False 'Reset for the Row
    For j = 0 To Me.ListBox2.ListCount - 1
        If ListBox2.List(j) = arr2(i, 7) Then
            bTest = True 'We found a match!
            Exit For 'No need to keep looking
        End If
    Next j
    If Not bTest Then 'If we didn't find a match
        For q = 1 To LastColumn
            arr2(i, q) = "" 'Blank the row
        Next q
    End If
Next i