VBA-检查集合中是否存在项，如果存在，则清除列表框中的其他项选择，但不清除该项

我试图检查集合中是否存在称为“All”的特定项

  Private Sub RefreshData_ListBox_Change()

    Dim ListBoxSelected As Collection
    Set ListBoxSelected = New Collection
    LbKey = 0

    Dim ReqValue As String
    Dim ItemReq As String

    For lItem = 0 To SelectRequiredQR.RefreshData_ListBox.ListCount - 1

        If SelectRequiredQR.RefreshData_ListBox.Selected(lItem) = True Then

            LbKey = LbKey + 1

            ReqValue = SelectRequiredQR.RefreshData_ListBox.List(lItem)

            ListBoxSelected.Add ReqValue, CStr(LbKey)

        End If

    Next

    TotalItems = ListBoxSelected.Count

    If TotalItems > 1 Then

如果项目总数大于1，则我要检查项目 在列表框中称为“全部”，如果存在，则我要清除 在列表框中选择其他项目，但不是“全部”

i=1至合计项目的

ItemReq=ListBoxSelected（i）
如果ItemReq=“全部”，则
对于j=TotalItems到0步骤-1
ItemReq=ListBoxSelected（j）
如果ItemReq为“全部”，则
'从集合中删除项目
ListBoxSelected.删除（j）
'从列表框中删除所选内容
选择RequiredQR.RefreshData\u列表框。选择（j）=真
如果结束
下一个
如果结束
下一个
如果结束

我的理解是，如果用户选择了“所有”项目，则应取消选择任何其他项目。然后您可以按照以下方式操作：

Private Sub RefreshData_ListBox_Change()
    Static bWorking As Boolean
    Dim lItem As Long
    Dim lUnselect As Long

    'Check the anti-recursion flag.        
    If Not bWorking Then
        For lItem = 0 To RefreshData_ListBox.ListCount - 1
            If RefreshData_ListBox.Selected(lItem) Then
                If StrComp(RefreshData_ListBox.List(lItem), "All", vbTextCompare) = 0 Then
                    'Manage recursion.
                    bWorking = True

                    For lUnselect = 0 To RefreshData_ListBox.ListCount - 1
                        If lUnselect <> lItem Then
                            RefreshData_ListBox.Selected(lUnselect) = False
                        End If
                    Next

                    bWorking = False
                End If
            End If
        Next
    End If
End Sub

私有子刷新数据\u列表框\u更改（）
作为布尔值的静态工作
暗淡如长
请选择“尽可能长”
'检查反递归标志。
如果不是这样的话
对于lItem=0，刷新数据\u ListBox.ListCount-1
如果选择了RefreshData\u ListBox.（lItem），则
如果StrComp（RefreshData_ListBox.List（lItem），“All”，vbTextCompare）=0，则
'管理递归。
b工作=真
对于lUnselect=0，刷新数据\u ListBox.ListCount-1
如果选择lItem，则
RefreshData_ListBox.Selected（lUnselect）=False
如果结束
下一个
b工作=错误
如果结束
如果结束
下一个
如果结束
端接头

尝试

For

循环以验证

刷新数据列表框（i）.Value

@DavidG.尝试了，但我从列表框中删除选择的代码对我无效。

SelectRequiredQR.RefreshData列表框。Selected（j）=**False**

注意递归；更改所选标志会触发更改事件。

Private Sub RefreshData_ListBox_Change()
    Static bWorking As Boolean
    Dim lItem As Long
    Dim lUnselect As Long

    'Check the anti-recursion flag.        
    If Not bWorking Then
        For lItem = 0 To RefreshData_ListBox.ListCount - 1
            If RefreshData_ListBox.Selected(lItem) Then
                If StrComp(RefreshData_ListBox.List(lItem), "All", vbTextCompare) = 0 Then
                    'Manage recursion.
                    bWorking = True

                    For lUnselect = 0 To RefreshData_ListBox.ListCount - 1
                        If lUnselect <> lItem Then
                            RefreshData_ListBox.Selected(lUnselect) = False
                        End If
                    Next

                    bWorking = False
                End If
            End If
        Next
    End If
End Sub