删除项目时出现复选框问题

checkbox issue when removing items

提问人:Learner11 提问时间:11/17/2023 最后编辑:braXLearner11 更新时间:11/17/2023 访问量:56

问:

当删除项目时,当复选框向上移动一行时,我遇到了这个问题。如何确保复选框不会上移或重复?因为现在我必须手动检查复选框是否重复,这不是一个理想的解决方案。
下面是用于删除项以供参考的代码。

Dim n, s   As Long
Dim bSelected As Boolean
Dim Cell, c As Range
Dim rng    As Range: Set rng = Range("A27:H42")
Dim ws     As Worksheet
Dim colItem As Long, sItem As String
Set ws = ThisWorkbook.Sheets("Data")
Dim selectedItems As New Collection
Set SelectedItem = New Collection

For n = 0 To Me.ListboxResult.ListCount - 1
    If Me.ListboxResult.Selected(n) Then
        bSelected = True
        Exit For
    End If
Next n

If Not bSelected Then
    MsgBox "Please select an item to remove.", vbOKOnly, "Selection Required"
    Exit Sub
End If

For s = s To Me.ListboxResult.ListCount - 1
    If Me.ListboxResult.Selected(s) Then
        selectedItems.Add s
    End If
Next s

colItem = 1                                   ' 2nd column in listbox
Set rng = ThisWorkbook.Sheets("Data").Range("E:E")
With ListboxResult
    For i = .ListCount To 1 Step -1
        If .Selected(i - 1) Then
            sItem = .List(i - 1, colItem)
            Set c = rng.Find(sItem, LookIn:=xlValues, lookat:=xlWhole)
            If Not c Is Nothing Then
                c.EntireRow.Delete
                Set c = Nothing
            Else
                'MsgBox sItem & " not found on sheet", vbExclamation
                Exit Sub
            End If
            .RemoveItem i - 1
        End If
    Next
End With
Excel VBA 复选框 用户窗体

评论


答: 暂无答案