Excel VBA:将今天的日期插入最后一行

时间:2017-03-09 12:47:39

标签: excel vba excel-vba

我正在尝试:

  1. 检查最后一行是否为空。
  2. 检查最后的非空白行是否包含今天的日期
  3. 如果没有,请在第一个空行中输入今天的日期,每个日期都由Dims指示。 (因为有5个单独的表需要日期)。
  4. 我的代码能做到这一点吗?我想在每次打开工作簿时更新它,但保留前一天输入的日期。因此,基本上,每当我需要更新数据时,今天的日期已经设置在那里,我可以将数据放入。

    代码:

    Private Sub Workbook_Open()
    
    Dim D1Col As Long, D2Col As Long, D3Col As Long, D4Col As Long, D5Col As Long, rowCnt As Long
    D1Col = 1
    D2Col = 4
    D3Col = 7
    D4Col = 10
    D5Col = 13
    endRow = Cells(Rows.Count, 1).End(xlUp).Row '<--| set 'endRow' to column A
    
    If endRow.Offset(1, 0).Value = 0 Then 'Does the zero idicate "if it is blank"?
        If endRow.Value <> Format(Now(), "mm/dd/yyyy") Then
            Cells(endRow.Offset(1, 0), D1Col) = Format(Now(), "mm/dd/yyyy")
            Cells(endRow.Offset(1, 0), D2Col) = Format(Now(), "mm/dd/yyyy")
            Cells(endRow.Offset(1, 0), D3Col) = Format(Now(), "mm/dd/yyyy")
            Cells(endRow.Offset(1, 0), D4Col) = Format(Now(), "mm/dd/yyyy")
            Cells(endRow.Offset(1, 0), D5Col) = Format(Now(), "mm/dd/yyyy")
        End If
    Else: endRow.Offset(1, 0).Value = 0
    
    End Sub
    

    数据示例:

    Screenshot of Data

4 个答案:

答案 0 :(得分:4)

我已经清理并重构以消除冗余代码,并明确了所有隐式ActiveSheet引用:

Private Sub Workbook_Open()

  Const startCol As Long = 1
  Const colCountToSet As Long = 5
  Const skipColCount As Long = 3

  Dim endRow  As Long
  endRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row

  If IsDate(Cells(endRow, startCol)) Then
    If Int(CDate(ActiveSheet.Cells(endRow, startCol))) <> Date Then
      endRow = endRow + 1
      Dim curCol As Long
      curCol = startCol
      Dim counter As Integer
      For counter = startCol To colCountToSet
        ActiveSheet.Cells(endRow, curCol) = Date
        curCol = curCol + skipColCount
      Next
    End If
  End If

End Sub

这里做了什么以及为什么:

  Const startCol As Long = 1
  Const colCountToSet As Long = 5
  Const skipColCount As Long = 3

如果您需要添加或删除一组列,请调整colCountToSet,您的代码将继续有效。

如果您为每个集添加另一列或在数据集之间添加空格,请调整skipColCount,您的代码将继续有效。

如果插入新的col A,请调整startCol

      Dim todaysDate As String       todaysDate =格式(现在(),&#34; mm / dd / yyyy&#34;)

多次调用Format()函数没有任何意义,您只对日期感兴趣,如果有人碰巧在此之前打开工作簿午夜,你可以可能在同一行上获得不同的日期。

  If IsDate(ActiveSheet.Cells(endRow, startCol)) Then

由于@Comintern的建议,我已经解决了这个问题。首先确保您的最后一行包含日期。如果由于某种原因,有人在底部输入了非日期值,则会跳过覆盖它。

    If Int(CDate(ActiveSheet.Cells(endRow, startCol))) <> Date Then

Date函数返回一个没有时间的日期(作为整数),因此将其与最后一行中的内容进行比较。

  If Format(ActiveSheet.Cells(endRow, startCol), "mm/dd/yyyy") <> todaysDate Then

如果最后一行为空,则不会匹配。如果是昨天的日期,它就不会匹配。这两种情况都属于If陈述。如果是今天的日期,它将匹配,它将跳过If声明。您必须格式化列中的日期以与您正在使用的格式完全匹配,因为单元格的显示格式可能会返回与您正在测试的字符串不同的字符串。

    endRow = endRow + 1

摆脱.Offset()。特别是因为您没有使用Range对象。

    For counter = startCol To colCountToSet
      ActiveSheet.Cells(endRow, curCol) = Date
      curCol = curCol + skipColCount
    Next

一个漂亮,简单的小循环,可以设置每个列的日期,而不必在代码的最顶部调整除CONST或2之外的任何内容,这样您的格式就会发生变化。它将日期设置为系统返回的Date整数。

答案 1 :(得分:3)

尝试类似下面的代码:

Dim D1Col As Long, D2Col As Long, D3Col As Long, D4Col As Long, D5Col As Long, rowCnt As Long
Dim endRow As Long

D1Col = 1
D2Col = 4
D3Col = 7
D4Col = 10
D5Col = 13



With Worksheets("Sheet4") ' <-- define which sheet to perform the tests below
    endRow = .Cells(.Rows.Count, "A").End(xlUp).Row ' <-- set 'endRow' to column A        
    If .Range("A" & endRow).Offset(1, 0).Value = 0 Or .Range("A" & endRow).Offset(1, 0).Value = "" Then   ' check is blank (maybe also zero, not sure whatthe PO wants) 
         If .Range("A" & endRow).Value <> Date Then
            .Cells(endRow + 1, D1Col) = Date
            .Cells(endRow + 1, D2Col) = Date
            .Cells(endRow + 1, D3Col) = Date
            .Cells(endRow + 1, D4Col) = Date
            .Cells(endRow + 1, D5Col) = Date
        End If
    Else
        .Range("A" & endRow).Offset(1, 0).Value = 0
    End If

End With

答案 2 :(得分:1)

我没有评论的声誉,但我认为你应该对VBA的基础知识进行一些训练,这里有一些提示:

endRow = Range("A1").End(xlDown).Row '<--| really set 'endRow' to column A in active sheet!
If Cells(endRow, D1Col).Value = "" Then 'if cell in active sheet is blank...
If Cells(endRow, D1Col).Value <> Date Then 'if active sheet cell value is today's date...
Cells(endRow + 1, D1Col).Value = Date 'set the cell in the next row to today's date
祝你好运

答案 3 :(得分:0)

您的代码无法正常工作,以下代码将返回错误..

endRow = Cells(Rows.Count, 1).End(xlUp).Row '<--| set 'endRow' to column A

If endRow.Offset(1, 0).Value = 0 Then 'Does the zero idicate "if it is blank"?

原因是endRow被赋值为Row属性,返回数值而不是Range对象,因此您无法从endRow变量访问Offset对象。 如果要访问lastNonBlank或firstBlank行,请使用下面的代码

Public Sub LastRow()
    Dim lastNonBlankRow As Range
    Dim firstBlankRow As Range

    Set lastNonBlankRow = Range("A1").End(xlDown)
    Set firstBlankRow = Range("A1").End(xlDown).Offset(1, 0)

    MsgBox lastNonBlankRow.Address
    MsgBox firstBlankRow.Address
End Sub