首页 > 解决方案 > 如何删除不符合用户输入条件的行?

问题描述

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

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

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

要搜索的值示例:“Sep 2018”

如果我可以在弹出框中生成默认值始终为上个月,格式为 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

标签: excelvba

解决方案


推荐阅读