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

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

1 个答案: