excel - 保存前根据当前日期删除行

Question

我有一个宏观繁重的表单/电子表格，每当保存工作表时，我都需要删除 col D 的日期早于当前日期的行。
换句话说，如果 D 列有一行 Feb 20 (2/20/2014)然后 VBA 将删除该行并将单元格向上移动，因为日期早于今天的日期。
下面是“ThisWorkbook”中的代码，它完全按照我需要的方式导出 XML，但底部添加的代码仅在我删除所有其他代码时才有效，必须有一种方法在保存之前执行这两个功能。此外，删除过时行的代码也会删除我想阻止的任何空单元格。

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)


'ThisWorkbook.Close SaveChanges:=True this will save on close, not sure if needed yet

Dim colIndex As Integer
Dim rwIndex As Integer
Dim asCols() As String
Dim oWorkSheet As Worksheet
Dim sName As String
Dim lCols As Long, lRows As Long
Dim iFileNum As Integer
Dim str_switch As String ' To use first column as node
Dim blnSwitch As Boolean

'--------Set WorkSheet and Columns and Rows

Set oWorkSheet = ThisWorkbook.Worksheets("Data")
sName = oWorkSheet.Name
lCols = oWorkSheet.Columns.Count
lRows = oWorkSheet.Rows.Count

ReDim asCols(lCols) As String

iFileNum = FreeFile
Open "C:\test.xml" For Output As #iFileNum

'move through columms

For i = 1 To lCols - 1

If Trim(oWorkSheet.Cells(2, i + 1).Value) = "" Then Exit For
    asCols(i) = oWorkSheet.Cells(2, i + 1).Value
Next i

If i = 0 Then GoTo ErrorHandler
    lCols = i

Print #iFileNum, "<?xml version=""1.0""?>"
Print #iFileNum, "<" & sName & ">" ' add sheet name to xml file as First Node

'----------------------------------------------------------------
 str_switch = "SDFSDKF" ' to trip loop

For i = 3 To lRows

    If Trim(oWorkSheet.Cells(i, 2).Value) = "" Then
        Exit For
    End If

Debug.Print oWorkSheet.Cells(i, 2).Value
    If str_switch <> oWorkSheet.Cells(i, 2).Value Then
        If blnSwitch = True Then
            Print #iFileNum, "</" & "Data" & ">"
        End If

            Print #iFileNum, "<" & "Data" & ">"
            Print #iFileNum, " <" & asCols(1) & ">" & Trim(oWorkSheet.Cells(i, 2).Value) & "</"  & asCols(1) & ">"
            blnSwitch = True
    Else

    End If
            Print #iFileNum,
            For j = 3 To lCols
                Print #iFileNum, " <" & asCols(j - 1) & ">" & Trim(oWorkSheet.Cells(i, j).Value) & "</" & asCols(j - 1) & ">"
            Next j

            Print #iFileNum,
     str_switch = oWorkSheet.Cells(i, 2).Value
    Next i

    '------------End & close File --------------------
    Print #iFileNum, "</" & "Data" & ">"
    Print #iFileNum, "</" & sName & ">"

    Close #iFileNum


 ErrorHandler:
   If iFileNum > 0 Then Close #iFileNum
   Exit Sub

 With Sheets("Main")
    LR = .Cells(Rows.Count, "D").End(xlUp).Row
    For i = LR To 2 Step -1
    If .Cells(i, "D").Value < Date Then
        .Rows(i).EntireRow.Delete
    End If
  Next i
 End With

  End Sub

Answer 1

第一的!把 Exit Sub在 End If Code 内部，这样它不在 ErrorHandler 条件下......这将防止在运行结束代码之前退出!

将处理程序更改为:

ErrorHandler:
   If iFileNum > 0 Then 
       Close #iFileNum
       Exit Sub
   End If

您也不需要指定 EntireRow，因为它不是选择，因为您已经在工作表的上下文中。您还应该指定要在删除后将shitcells UP。

修改为不删除空日期

With Sheets("Main")
    LR = .Cells(Rows.Count, "D").End(xlUp).Row
    For i = LR To 2 Step -1
    If Not IsEmpty(.Cells(i, "D").Value) AND .Cells(i, "D").Value < Date Then
        .Rows(i).Delete  Shift:=xlUp
    End If
  Next i
End With