vba excel 列表框搜索和删除

Question

首先对我的数据表做一个简短的解释： sheet("Database") - A1 to L10000 (entries) A1 到 L1 中每列的标题 我尝试使用用户表单在工作表中进行搜索。 我在那里使用了 ComboBox，因为总是有相同的物质（25 种不同的物质）。 对于 output，我使用了一个列表框。

所以我的问题是，我想从我的工作表（“数据库”）中的搜索 function 中删除选定的 output。

例如搜索“物质 1”[ComboBox]

搜索后：

列表框

列头为空（如何在搜索后显示列头？）

第一行：物质 1

第二行：物质 1...

所以我选择了第二行并按下按钮“删除”/现在它删除了一个完全不同的条目，而不是我选择的那个。 我怎样才能做到这一点？ 如何使用所选信息删除正确的行？

我可以在不搜索 function 的情况下删除工作表中的选定行，因为在这种情况下，它确实删除了正确的行。

抱歉，如果我解释得不好，但我对 vba 很陌生。

谢谢你尽你所能的帮助。

VBA Excel 代码：

'''''''''''''''''''''''''''''''''''''''''''' '列表框- 数据库表的条目

Private Sub Refresh_data()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Database")

Dim lr As Long
lr = Sheets("Database").Range("A" & Rows.Count).End(xlUp).Row

 If lr = 1 Then lr = 2 
 With Me.ListBox1
    .ColumnCount = 13
    .ColumnHeads = True
    .RowSource = "Database!A2:L" & lr
 End With
 End Sub

''''''''''''''''''''''''''''''''''''''''''''' '搜索在工作表“数据库”中

 Private Sub CommandButton7_Click()  'Search Button

 Dim sh1 As Worksheet
 Dim row As Long

Worksheets("Database").Activate

UserForm2.ListBox1.RowSource = "" 

Set sh1 = ThisWorkbook.Sheets("Database")

For row = 2 To sh1.Cells(Rows.Count, 2).End(xlUp).Row

If InStr(1, sh1.Cells(row, 2).Value, Me.ComboBox.Value) <> 0 Then

Me.ListBox1.AddItem sh1.Cells(row, 1).Value                               
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = sh1.Cells(row, 2).Value  
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = sh1.Cells(row, 3).Value  
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = sh1.Cells(row, 4).Value  
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = sh1.Cells(row, 5).Value  
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = sh1.Cells(row, 6).Value 
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = sh1.Cells(row, 7).Value  
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 7) = sh1.Cells(row, 8).Value 
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 8) = sh1.Cells(row, 9).Value  
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 9) = sh1.Cells(row, 10).Value 

End If

Next Zeile

End Sub

''''''''''''''''''''''''''''''''''''''''''''删除入口

Private Sub CommandButton6_Click() 'Delete Button

Worksheets("Database").Activate

Dim a As String

Dim i As Long

For i = 0 To ListBox1.ListCount - 1             
    If ListBox1.Selected(i) = True Then         
    Rows(i + 2).EntireRow.Delete            
    End If
Next

Call Refresh_data 

End Sub

Answer 1

将行号添加到搜索结果中。 如果列表框显示完整数据，您只能从搜索结果中删除。 我将结果涂成黄色以显示差异。

Option Explicit

Private Sub Refresh_data()
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("Database")
    
    Dim lr As Long
    lr = Sheets("Database").Range("A" & Rows.Count).End(xlUp).row
    
     If lr = 1 Then lr = 2
     With Me.ListBox1
        .BackColor = vbWhite
        .ColumnWidths = ""
        .ColumnCount = 12
        .ColumnHeads = True
        .RowSource = "Database!A2:L" & lr
     End With
 End Sub

Private Sub CommandButton7_Click()  'Search Button

    Dim sh1 As Worksheet, c As Long, data, s As String
    Dim LastRow As Long, row As Long, i As Long
    
    Set sh1 = ThisWorkbook.Sheets("Database")
    LastRow = sh1.Cells(Rows.Count, 2).End(xlUp).row
    data = sh1.Range("A1:L" & LastRow).Value
    s = Me.ComboBox.Value
    
    With Me.ListBox1
        .RowSource = ""
        .ColumnCount = 10
        .ColumnWidths = "0" ' hide row numbers
        .BackColor = RGB(240, 240, 200)
        
        For row = 2 To LastRow
            If InStr(1, data(row, 2), s) <> 0 Then
                .AddItem row
                i = .ListCount - 1
                For c = 1 To 9
                   .List(i, c) = data(row, c)
                Next
            End If
        Next
        
    End With

End Sub

Private Sub CommandButton6_Click() 'Delete Button
       
    Dim sh1 As Worksheet, i As Long, r As Long
    Set sh1 = ThisWorkbook.Sheets("Database")
    
    With ListBox1
        ' only delete from filtered list
        If .ColumnCount > 10 Then Exit Sub
        For i = 0 To .ListCount - 1
            If .Selected(i) = True Then
                r = .List(i, 0) ' row in col 0
                sh1.Rows(r).EntireRow.Delete
            End If
        Next
    End With
    Call CommandButton7_Click

End Sub