如何每天自动将日期添加到excel中日期列表的底部

Question

我在 Excel 的列中有一个连续日期列表（1/01/2012、2/01/2012、3/01/2012 等）。我希望 Excel 检查当前日期并将该日期添加到范围的底部，如果它已经不存在的话。我只希望这种情况每天发生一次，这样就没有多余的条目。

例如：

如果列表在 2013 年 2 月 6 日结束，而我在 2013 年 2 月 6 日打开工作簿，则不会发生任何事情。但是，如果我在第二天（2013 年 3 月 6 日）再次打开工作簿，那么该日期将自动添加到列表底部。

我还需要将两个公式复制到该行的下两个单元格中。如果为A20 生成日期，则公式将在B20 和C20 上。对于每个新的日期条目，年/月/日的单元格引用需要增加 1（如一行）。

供参考，第一个公式为：

=SUMIF('Sheet1'!A:A,DATE(YEAR(A1),MONTH(A1),DAY(A1)),'Sheet1'!C:C)` 

而另一个公式足够相似，对于解决这个问题来说是多余的。

提前致谢。

编辑：

我想出了如何检查列表并添加新日期

Sub CheckDateAndEnter()
    If Sheet10.Cells(Rows.Count, 1).End(xlUp).Value <> Date Then
        Sheet10.Cells(Rows.Count, 1).End(xlUp)(2, 1) = Date
        Sheet10.Cells(Rows.Count, 1).End(xlUp)(1, 2) = "=SUMIF('Sheet1'!A:A,DATE(YEAR(A304),MONTH(A304),DAY(A304)),'Sheet1'!C:C)"
    End If
End Sub

但是，每次发生这种情况时，公式中的那些单元格引用都需要为新列增加一次，我不确定如何实现。

Answer 1

如果您将此代码放入 VBA 编辑器中的“ThisWorkbook”模块中，并确保将文件作为“启用宏的工作簿”进行保护，它应该可以工作。

在这里对公式进行硬编码可能不是最好的方法，我使用 R1C1 表示法可能会更简洁。

Private Sub Workbook_Open()
Dim Sheet As Worksheet: Set Sheet = ThisWorkbook.Worksheets("Sheet1") ' Reference to your worksheet
Dim Entry As Range: Set Entry = Sheet.Cells(Sheet.Rows.Count, 1).End(xlUp) ' The Last Populated Cell in Column A
If IsEmpty(Entry) = True Then ' Optional, Used to populate the first cell
    Entry.Value = Date
    Entry.Offset(ColumnOffset:=1).Formula = "=SUMIF('Sheet1'!A:A,DATE(YEAR(A" & Entry.Row & "),MONTH(A" & Entry.Row & "),DAY(A" & Entry.Row & ")),'Sheet1'!C:C)` "
    Exit Sub
End If
If Year(Entry) = Year(Date) Then
    If Month(Entry) = Month(Date) Then
        If Day(Entry) = Day(Date) Then
            Exit Sub ' Last Entry = Today, Do Nothing!
        End If
    End If
End If
Set Entry = Entry.Offset(RowOffset:=1) ' Last Entry != Today, Goto Next Row and create Entry.
Entry.Value = Date
Entry.Offset(ColumnOffset:=1).Formula = "=SUMIF('Sheet1'!A:A,DATE(YEAR(A" & Entry.Row & "),MONTH(A" & Entry.Row & "),DAY(A" & Entry.Row & ")),'Sheet1'!C:C)` "
End Sub