删除列表框中选择的多行的代码（VBA）答案

【问题标题】：Code for Deleting Multiple Rows Selected in ListBox (VBA)删除列表框中选择的多行的代码（VBA）
【发布时间】：2019-03-20 15:12:46
【问题描述】：

目前，我正在参与一个项目，在该项目中我被困在为以下提到的活动编写代码。

我创建了一个带有多选列表框和命令按钮的用户窗体

a) ListBox 使用 2 列填充来自 表格源 的项目。

Zone    Region
North   N1
North   N2
North   N3
North   N4
South   S1
South   S2
South   S3
South   S4
East    E1
East    E2

b) 命令按钮用于删除列表框中选定的项目。

现在，一旦我单击 Delete Command Button ，选定的行应该会在原始表源中被删除。

问题

我面临的问题是，即使我在列表框中选择了 2 行或更多行，也只有 最后选择的行会被删除。

Private Sub Cmd_Del_Click()
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Worksheets("Sheet1")
    Dim i As Long


    For i = Me.LB_ZoneRegion.ListCount - 1 To 0 Step -1
        If Me.LB_ZoneRegion.Selected(i) = True Then
            sh.Range("A" & i + 2 & ":B" & i + 2).Select
            Selection.Delete
        End If
    Next i
    Call UserForm_Initialize
End Sub

Private Sub UserForm_Initialize()
    On Error Resume Next
    With Me.LB_ZoneRegion
        .Clear
        .ColumnCount = 2
        .ColumnHeads = True
        .ColumnWidths = "40;50"
        .RowSource = "ZoneRegion"
        .MultiSelect = fmMultiSelectMulti
    End With
End Sub

点击以下链接下载工作文件。 https://drive.google.com/open?id=1P5wiW6WVFAVQBgixPuA7gqyacR1aktvi

请在这方面帮助我。

【问题讨论】：

您是否尝试过使用键盘上的F8 单步执行您的代码，并在VBE 的Locals 窗口中的循环的每次迭代中密切关注您的Me.LB_ZoneRegion.Selected(i) 值？通过单步执行代码，您还可以检查您的代码是否按预期运行（例如，循环没有比预期提前退出......等等）。
@Ganesh - 发布了一种使用 Union 函数解决您的问题的方法。

标签： excel vba listbox userform

【解决方案1】：

使用Union避免重复删除

使用Union 函数，您可以将所有要删除的行添加到一个范围对象（例如DelRng），最后通过一个代码行DelRng.Delete 将它们删除。

接近 OP 的示例代码

Private Sub Cmd_Del_Click()
    Dim sh As Worksheet
    Dim DelRng As Range
    Set sh = ThisWorkbook.Worksheets("Sheet1")
    Dim i As Long
    For i = 0 to Me.LB_ZoneRegion.ListCount - 1    ' no more need to loop backwards
        If Me.LB_ZoneRegion.Selected(i) = True Then
            If DelRng Is Nothing Then
                Set DelRng = sh.Range("A" & i + 2 & ":B" & i + 2)
            Else
                Set DelRng = Union(DelRng, sh.Range("A" & i + 2 & ":B" & i + 2))
            End If
        End If
    Next i
    Application.ScreenUpdating = False
    If Not DelRng Is Nothing Then DelRng.Delete    ' delete chosen rows (if any)
    Application.ScreenUpdating = True


End Sub

注意

您还应该提供用户删除整个命名范围的情况。

【讨论】：