我想记录一个宏,该宏将删除数据表中与用户定义的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