VBA ListBox筛选状态下无法删除指定行的问题求助

我的VBA代码在未进行搜索筛选时，可正常删除ListBox及工作表中的行，但通过SearchBy选择类别、SearchValue输入值筛选后，选中行点击删除按钮无法删除对应行。需求是实现筛选后选中某一行即可删除该指定行，怀疑是未正确调用存储数据的工作表，但无法定位原因。

原删除按钮代码：

Private Sub cmdDelete_Click()
    
    Dim d As Integer 'test
    
    For d = 1 To Range("D500").End(xlUp).Row - 1
        If ListDatabase.Selected(d) Then
        Rows(d + 1).Select
            Selection.Delete
        End If
    Next d
Call Reset
     
    
End Sub

原搜索按钮代码：

Private Sub cmdSearch_Click()

    If Me.txtSearchValue.Value = "" Then
        MsgBox "Enter search value.", vbOKOnly + vbInformation, "Search"
        Exit Sub
    End If
    
    Call SearchData
    
End Sub

原SearchData子程序代码：

Sub SearchData()
    Application.ScreenUpdating = False
    Dim shRCA As Worksheet '<-RCA sheet
    Dim shSearchData As Worksheet '<-SearchData sheet
    Dim iColumn As Integer 
    Dim iRCARow As Long
    Dim iSearchRow As Long 
    Dim sColumn As String 
    Dim sValue As String
    Set shRCA = ThisWorkbook.Sheets("RCA")
    Set shSearchData = ThisWorkbook.Sheets("SearchData")
    
    iRCARow = ThisWorkbook.Sheets("RCA").Range("D" & Application.Rows.Count).End(xlUp).row

    sColumn = RCAForm.cmbSearchBy.Value
    
    sValue = RCAForm.txtSearchValue.Value
    
    iColumn = Application.WorksheetFunction.Match(sColumn, shRCA.Range("D1:U1"), 0)
    
    'Remove filter from RCA worksheet
    If shRCA.FilterMode = True Then
        shRCA.AutoFilterMode = False
    End If
    
    If RCAForm.cmbSearchBy.Value = "Case Number" Then
        shRCA.Range("D1:U" & iRCARow).AutoFilter Field:=iColumn, Criteria1:=sValue
    Else
        shRCA.Range("D1:U" & iRCARow).AutoFilter Field:=iColumn, Criteria1:="*" & sValue & "*"
    End If
    
    'If any record found
    If Application.WorksheetFunction.Subtotal(3, shRCA.Range("G:G")) >= 2 Then
        
        'Code to remove the previous data from SearchData worksheet
        shSearchData.Cells.Clear
        shRCA.AutoFilter.Range.Copy shSearchData.Range("D1")
        Application.CutCopyMode = False
        
        iSearchRow = shSearchData.Range("D" & Application.Rows.Count).End(xlUp).row
        RCAForm.ListDatabase.ColumnCount = 19
        RCAForm.ListDatabase.ColumnWidths = "30, 30, 30, 30, 50, 50, 90, 90, 90, 90, 50, 40, 40, 40, 50, 50, 50, 50"
        
        If iSearchRow > 1 Then
            RCAForm.ListDatabase.RowSource = "SearchData!D2:U" & iSearchRow
            MsgBox "Records Found!"
        End If
    
    Else
        MsgBox "No Record Found."
    
    End If
    
    'To remove filter from worksheet
    shRCA.AutoFilterMode = False
    Application.ScreenUpdating = True
    
End Sub

1. 行索引不匹配：筛选后ListBox绑定的是SearchData工作表的筛选结果，原删除代码直接用ListBox的索引对应RCA工作表的行号，两者无关联，导致删除错误行或无法找到目标行。
2. 未指定工作表：原删除代码中Range、Rows操作未明确指定工作表，默认使用当前激活表，易引发逻辑错误。
3. 缺失原始数据映射：筛选后没有记录结果在RCA表中的原始行号，无法建立ListBox选项与原始数据的关联。

1. 修改SearchData子程序，添加原始行号映射 #

在筛选后复制数据到SearchData时，新增一列存储RCA表的原始行号，用于后续删除时定位：

Sub SearchData()
    Application.ScreenUpdating = False
    Dim shRCA As Worksheet '<-RCA sheet
    Dim shSearchData As Worksheet '<-SearchData sheet
    Dim iColumn As Integer
    Dim iRCARow As Long
    Dim iSearchRow As Long
    Dim sColumn As String
    Dim sValue As String
    Set shRCA = ThisWorkbook.Sheets("RCA")
    Set shSearchData = ThisWorkbook.Sheets("SearchData")
    
    iRCARow = shRCA.Range("D" & Application.Rows.Count).End(xlUp).Row

    sColumn = RCAForm.cmbSearchBy.Value
    sValue = RCAForm.txtSearchValue.Value
    
    iColumn = Application.WorksheetFunction.Match(sColumn, shRCA.Range("D1:U1"), 0)
    
    'Remove filter from RCA worksheet
    If shRCA.FilterMode = True Then
        shRCA.AutoFilterMode = False
    End If
    
    If RCAForm.cmbSearchBy.Value = "Case Number" Then
        shRCA.Range("D1:U" & iRCARow).AutoFilter Field:=iColumn, Criteria1:=sValue
    Else
        shRCA.Range("D1:U" & iRCARow).AutoFilter Field:=iColumn, Criteria1:="*" & sValue & "*"
    End If
    
    'If any record found
    If Application.WorksheetFunction.Subtotal(3, shRCA.Range("G:G")) >= 2 Then
        
        'Code to remove the previous data from SearchData worksheet
        shSearchData.Cells.Clear
        '新增列存储原始行号，放在D列前
        shSearchData.Range("C1").Value = "OriginalRow"
        shRCA.AutoFilter.Range.Columns(1).EntireRow.Copy shSearchData.Range("C2") '复制RCA表的原始行号
        shRCA.AutoFilter.Range.Copy shSearchData.Range("D1") '复制筛选后的数据
        Application.CutCopyMode = False
        
        iSearchRow = shSearchData.Range("D" & Application.Rows.Count).End(xlUp).Row
        RCAForm.ListDatabase.ColumnCount = 20 '列数+1，对应新增的原始行号列
        '隐藏原始行号列（宽度设为0）
        RCAForm.ListDatabase.ColumnWidths = "0, 30, 30, 30, 30, 50, 50, 90, 90, 90, 90, 50, 40, 40, 40, 50, 50, 50, 50"
        
        If iSearchRow > 1 Then
            RCAForm.ListDatabase.RowSource = "SearchData!C2:U" & iSearchRow '绑定包含原始行号的区域
            MsgBox "Records Found!"
        End If
    
    Else
        MsgBox "No Record Found."
    
    End If
    
    'To remove filter from worksheet
    shRCA.AutoFilterMode = False
    Application.ScreenUpdating = True
End Sub

2. 修改删除按钮代码，通过原始行号删除目标行 #

利用ListBox隐藏列中的原始行号，定位RCA表中的目标行并删除：

Private Sub cmdDelete_Click()
    Dim d As Integer
    Dim shRCA As Worksheet
    Dim originalRow As Long
    
    Set shRCA = ThisWorkbook.Sheets("RCA")
    
    '从后往前遍历，避免删除行后索引错乱
    For d = ListDatabase.ListCount - 1 To 0 Step -1
        If ListDatabase.Selected(d) Then
            originalRow = CLng(ListDatabase.List(d, 0)) '获取隐藏列的原始行号
            shRCA.Rows(originalRow).Delete '删除RCA表中的对应行
            ListDatabase.RemoveItem d '从ListBox中移除该行
        End If
    Next d
    
    Call Reset
End Sub

补充说明 #

• 新增的OriginalRow列用于存储RCA表的原始行号，设置列宽为0隐藏，不影响用户操作体验。
• 删除时从后往前遍历ListBox，避免删除行后后续索引错位导致漏删或误删。
• 所有操作均明确指定工作表，避免激活工作表切换带来的逻辑错误。

内容的提问来源于stack exchange，提问作者Litsub