vba，如何从列表框中的工作表中删除过滤后的数据

Posted 2021-04-18

我创建了一个userform，当打开时显示一个名为lstNewDisplay的列表框中的工作簿（单元格A到H）中的数据我有一段代码（下面）根据我想要的文本框txtNewSearch中输入的值过滤数据创建一个按钮，可以删除从列表框lstNewDisplay中选择的行，并从工作表上的行中删除该行。该按钮需要能够删除已过滤和未过滤的数据行。我尝试了一些不同的代码来使其工作，但是当数据被过滤时，它会删除错误的行。但是我在删除未过滤的行方面取得了一些成功。如果没有办法让代码删除过滤和未过滤的数据，我宁愿它从列表框和工作簿中删除过滤的数据行。

对不起，如果我没有好好解释这个问题，那么我就是新手，并且在我学习的过程中学习。

谢谢你尽你所能的帮助。

Private Sub CommandButton6_Click()
lstNewDisplay.RowSource = ""
lstNewDisplay.Value = ""
Dim i As Long
On Error Resume Next
Me.lstNewDisplay.Clear
For i = 2 To Application.WorksheetFunction.CountA(Sheet2.Range("A:A"))
For x = 1 To 8
a = Len(Me.txtNewSearch.Text)
If Left(Sheet2.Cells(i, x).Value, a) = Me.txtNewSearch.Text And Me.txtNewSearch.Text <> "" Then
Me.lstNewDisplay.AddItem Sheet2.Cells(i, 1).Value
For c = 1 To 8
Me.lstNewDisplay.List(lstNewDisplay.ListCount - 1, c) = Sheet2.Cells(i, c + 1).Value
Next c
End If
Next x
Next i
End Sub

答案

所以，这就是我想出来的......尝试一下，看看它对你有用。我不得不修改你的大部分代码。

为了实现你的目标，我要做的第一件事就是更改Private Sub UserForm_Activate()事件，因为你可能正在使用lstNewDisplay.RowSource =为列表框分配范围，我们需要知道每行上的工作表行是什么这个列表，我们以后可以告诉excel删除哪个工作表行。

所以我的活动看起来像这样......

注意：我正在使用集合全局变量来保留工作表行以供以后使用。

Option Explicit
Private coll As Collection
Private Sub UserForm_Activate()

 Dim LastRow As Long
 Dim a As Long
 Dim b As Long
 Dim i As Long

 LastRow = Sheets("Filter").Cells(Rows.Count, "A").End(xlUp).Row
 Set coll = New Collection

 a = 0
 b = 1

 For i = 2 To LastRow

 coll.Add i
 With Me.lstNewDisplay

 .AddItem
 .List(a, 0) = Sheets("Filter").Cells(i, 1)
 .List(a, 1) = Sheets("Filter").Cells(i, 2)
 .List(a, 2) = Sheets("Filter").Cells(i, 3)
 .List(a, 3) = Sheets("Filter").Cells(i, 4)
 .List(a, 4) = Sheets("Filter").Cells(i, 5)
 .List(a, 5) = Sheets("Filter").Cells(i, 6)
 .List(a, 6) = Sheets("Filter").Cells(i, 7)
 .List(a, 7) = Sheets("Filter").Cells(i, 8)

 End With

 b = b + 1
 a = a + 1

 Next

End Sub

这就是我编码过滤按钮的方式......

Private Sub btnFiltered_Click()

  Dim LastRow As Long
  Dim LastColumn As Long
  Dim c As Range
  Dim a As Long
  Dim b As Long
  Dim firstaddress As String

  If Me.txtNewSearch.Text <> "" Then

  Set coll = New Collection
  Me.lstNewDisplay.RowSource = ""
  Me.lstNewDisplay.Clear

  LastRow = Sheets("Filter").Cells(Rows.Count, "A").End(xlUp).Row
  LastColumn = Sheets("Filter").Cells(2, Columns.Count).End(xlToLeft).Column

  a = 0
  b = 0

  With Sheets("Filter").Range(Cells(2, 1), Cells(LastRow, LastColumn))
  Set c = .Find(Me.txtNewSearch.Text, LookIn:=xlValues, LookAt:=xlWhole)

  If Not c Is Nothing Then
  firstaddress = c.Address

   Do

   With Me.lstNewDisplay
  .AddItem

  .List(a, 0) = Sheets("Filter").Cells(c.Row, 1)
  .List(a, 1) = Sheets("Filter").Cells(c.Row, 2)
  .List(a, 2) = Sheets("Filter").Cells(c.Row, 3)
  .List(a, 3) = Sheets("Filter").Cells(c.Row, 4)
  .List(a, 4) = Sheets("Filter").Cells(c.Row, 5)
  .List(a, 5) = Sheets("Filter").Cells(c.Row, 6)
  .List(a, 6) = Sheets("Filter").Cells(c.Row, 7)
  .List(a, 7) = Sheets("Filter").Cells(c.Row, 8)

  a = a + 1

  End With

  coll.Add c.Row

  Set c = .FindNext(c)

  If c Is Nothing Then
  GoTo DoneFinding
  End If

  Loop While c.Address <> firstaddress
  End If

DoneFinding:
  End With

  End If


End Sub

最后这里是删除按钮......

Private Sub btndelete_Click()

Dim i As Long
Dim a As Long
Dim item As Variant

For i = 0 To Me.lstNewDisplay.ListCount - 1

If Me.lstNewDisplay.Selected(i) Then

For a = 1 To coll.Count

If Sheets("Filter").Cells(coll.item(a), 1).Text = Me.lstNewDisplay.List(i, 0) And Sheets("Filter").Cells(coll.item(a), 8).Text = Me.lstNewDisplay.List(i, 7) Then

Me.lstNewDisplay.RemoveItem (i)
Sheets("Filter").Rows(coll.item(a)).EntireRow.Delete
coll.Remove (a)
Exit For

End If

Next

End If

Next

End Sub