Как я могу удалить строки, которые не соответствуют условиям ввода пользователя? - PullRequest
0 голосов
/ 13 февраля 2019

Я хочу записать макрос, который удалит любую строку в таблице данных, которая НЕ соответствует значению ячейки в столбце G, который пользователь определяет, и сдвигает оставшиеся строки вверх.Например, если я хочу удалить все строки, которые не имеют «Dec 2018» в столбце G.

Насколько я понимаю, этот код из кампуса Excel ниже может создать всплывающее окно для определения пользователемчто они ищут, но мне неясно, как изменить условия так, чтобы он удалял любую строку, которая не соответствует условию, а не соответствует условию:

Sub RemoveOldReleases()
'Display Yes/No message prompt before deleting rows
'Source: https://www.excelcampus.com/vba/delete-rows-cell-values/

Dim lo As ListObject
Dim lRows As Long
Dim vbAnswer As VbMsgBoxResult
Dim sCriteria As Variant

  'Set reference to the sheet and Table.
  Set lo = RAW.ListObjects(1)
  lo.Parent.Activate 'Activate sheet that Table is on.

  'Clear any existing filters
  lo.AutoFilter.ShowAllData

  'Ask user for input
  sCriteria = Application.InputBox(Prompt:="Please enter the release month your trying to keep in the format Sep 2018" _
                                    & vbNewLine & "Leave the box empty to filter for blanks.", _
                                    Title:="Filter Criteria", _
                                    Type:=2)

  'Exit if user presses Cancel button
  If sCriteria = False Then Exit Sub

  '1. Apply Filter
  lo.Range.AutoFilter Field:=7, Criteria1:=sCriteria

  'Count Rows & display message
  On Error Resume Next
    lRows = WorksheetFunction.Subtotal(103, lo.ListColumns(1).DataBodyRange.SpecialCells(xlCellTypeVisible))
  On Error GoTo 0

  vbAnswer = MsgBox(lRows & " Rows will be deleted.  Do you want to continue?", vbYesNo, "Delete Rows Macro")

  If vbAnswer = vbYes Then

    'Delete Rows
    Application.DisplayAlerts = False
      lo.DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
    Application.DisplayAlerts = True

    'Clear Filter
    lo.AutoFilter.ShowAllData

  End If

End Sub

Вот скриншотМоя таблица данных: https://i.stack.imgur.com/KhXmK.png

Имя моей рабочей книги: MasterSKUImport.xlsm

Имя моей рабочей таблицы: RAW

Диапазон ячеек: A1: J100000

Столбецсо значением: G

Пример значения для поиска: «сентябрь 2018»

Бонусные баллы, если я могу сгенерировать значение по умолчанию во всплывающем окне, чтобы всегда быть предыдущим месяцем вформат Ммм ГГГГ (сентябрь 2018 г.).

ОБНОВЛЕНИЕ:

Я пробовал этот код в соответствии с предложением @SJR, и он работает!:

Sub RemoveOldReleases()

Dim ws As Worksheet

Set ws = ThisWorkbook.Worksheets("RAW")

  'Ask user for input
  sCriteria = Application.InputBox(Prompt:="Please enter the Release Month you're trying to keep in the format Mmm YYYY (ex. Sep 2018)", _
                                Title:="Release Month", _
                                Default:=Format(DateAdd("m", -1, Date), "mmm yyyy"), _
                                    Type:=2)

  'Exit if user presses Cancel button
  If sCriteria = False Then Exit Sub

  '1. Apply Filter
  ws.Range("$A$1:$J$100000").AutoFilter Field:=7, Criteria1:="<>*" & sCriteria & "*", Operator:=xlFilterValues

    'Delete Rows
    Application.DisplayAlerts = False
      ws.Range("$A$2:$J$100000").SpecialCells(xlCellTypeVisible).Delete
    Application.DisplayAlerts = True

    'Clear Filter
    ws.Range("$A$1:$J$100000").AutoFilter

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...