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

Posted 2021-05-05

我有一个代码，将我的Excel文件的所有数据（行= 12,5k +和列= 97）放入二维字符串中。然后它循环通过某个列（“G”）列出一个只有唯一发现的列表框（“listbox1”）。然后在Userform中，用户可以选择一些找到的项目并将其转换为另一个列表框（“Listbox2”）然后当用户点击按钮（CommandButton4）时，我希望代码只在行中过滤数组在列“G”中，它与listbox2中的一个（或多个）给定条件相同。当它在列表框中只有一个项目但在列表框中有两个项目时，它只返回空白。

有人可以告诉我我做错了什么因为我不知道。

码：

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

答案

问题是你的第二个嵌套循环：

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）=“第一”

如果G列为“First”，则不执行任何操作

否则，如果列G =“第二”，则使整个行包含空白

此时，列G的唯一可能值现在是“第一”或空白

j = 1

ListBox2.List（1）=“第二个”

如果列G是“第二”，则什么都不做但是，这不可能发生，因为您已经将任何“第二行”更改为空白

否则，将整个行设为空白

此时，Row将始终为Blank

我建议使用布尔测试变量。在每个Row循环的开头将其设置为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