vba, как можно удалить отфильтрованные данные с листа в списке

Question

Я создал пользовательскую форму, которая при открытии отображает данные из рабочей книги (ячейки от A до H) в списке с именем lstNewDisplay У меня есть фрагмент кода (ниже), который фильтрует данные на основе значения, введенного в текстовом поле txtNewSearch Я хочу создать кнопку, которая может удалить строку, выбранную из списка lstNewDisplay, и удалить эту строку из строки на рабочем листе. Кнопка должна быть в состоянии удалить строку отфильтрованных и нефильтрованных данных. Я пробовал несколько разных частей кода, чтобы заставить это работать, однако, когда данные фильтруются, он удаляет неправильную строку. Однако у меня был некоторый успех, удаляя нефильтрованный ряд. Если код не может удалить как отфильтрованные, так и нефильтрованные данные, я бы предпочел, чтобы он удалил строку отфильтрованных данных из списка и рабочей книги.

Извините, если я не объясняю это хорошо, я очень новичок в via и учусь по ходу дела.

Спасибо за любую помощь, которую вы можете предложить.

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

Answer 1

Итак, это то, что я придумал ... попробуйте и посмотрите, как это работает для вас. Мне пришлось изменить большую часть вашего кода.

Чтобы достичь вашей цели, первое, что мне нужно было сделать, это изменить событие 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