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

我有一个宏大的表格/电子表格，我需要删除行，其中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

来源

2014-02-27 user3357423

你的代码不工作底部的哪一部分？另外**什么**不工作？ – Alex

您需要反转功能..........在**保存**编码之前移动行删除编码**。 –

不工作的部分是... – user3357423

首先！将Exit Sub放在End If代码中，这样它就不会处于ErrorHandler状态......这将阻止在运行结束代码之前退出！

更改的处理程序是：

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

您也不需要指定EntireRow，因为它不是一个选择，因为你已经在你工作的环境。您还应该指定想要在删除后拔出电池。

修改为不删除空日期

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

来源

2014-02-27 20:43:59

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

回答

相关问题