时间戳

首页 > 解决方案 > 如果单元格包含今天的日期，则删除整行

excel - 如果单元格包含今天的日期，则删除整行

问题描述

我正在尝试在 Excel 中编写一个宏来执行多项任务，如果当前日期在 A 列中，则最终任务是删除整行。

这是我记录的。我尝试使用我在网上找到的其他脚本来完成最终任务，但它没有完成。我没有收到任何类型的错误消息。

Sub NCR()
'
' NCR Macro
'

'
Cells.Select
With Selection
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
End With
Cells.Select
Cells.EntireColumn.AutoFit
Columns("A:B").Select
Selection.Delete Shift:=xlToLeft
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
Columns("H:K").Select
Selection.Delete Shift:=xlToLeft
Rows("2:1048576").Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range( _
    "E2:E1076"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
    .SetRange Range("A2:AI1076")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Rows("1:1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$AI$84").AutoFilter Field:=5, Criteria1:= _
    "In Progress"
Cells.Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Cells.Select
Application.CutCopyMode = False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Cells.EntireColumn.AutoFit
Rows("2:1048576").Select
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add2 Key:=Range( _
    "A2:A1048501"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
    .SetRange Range("A2:AI1048501")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Range("B14").Select
  With Range("A2:A500" & lastrow)
.AutoFilter 1, "=" & CLng(Date)
.Offset(1).EntireRow.Delete
.AutoFilter
End With
End Sub

我绝不是录制宏的专家，但在我进入“Range B14 Select”之前一切正常。之后，脚本停止，没有任何错误消息。

我究竟做错了什么？如何解决这个问题？

标签： excelvba

解决方案

代替

With Range("A2:A500" & lastrow)
.AutoFilter 1, "=" & CLng(Date)
.Offset(1).EntireRow.Delete
.AutoFilter
End With

和

Dim i
For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
    If Cells(i, 1) = Date Then Rows(i).Delete
Next

推荐阅读