如何删除不符合用户输入条件的行?

时间:2019-02-13 19:55:58

标签: excel vba

我想记录一个宏,该宏将删除数据表中与用户定义的G列中的单元格值不匹配的任何行,并将剩余的行上移。例如,如果我要删除G列中没有“ Dec 2018”的任何行。

我的理解是,下面来自Excel Campus的这段代码可能会生成一个弹出框,供用户定义他们要查找的内容,但是我不清楚如何更改条件,以便删除任何不符合条件的行。 t符合条件而不是符合条件:

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年9月”

如果我可以在弹出框中生成默认值始终为上个月,则以Mmm YYYY格式表示奖励(2018年9月)。

更新:

我已经按照@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

0 个答案:

没有答案