我正在尝试:
我的代码能做到这一点吗?我想在每次打开工作簿时更新它,但保留前一天输入的日期。因此,基本上,每当我需要更新数据时,今天的日期已经设置在那里,我可以将数据放入。
代码:
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
数据示例:
答案 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