宏随着日期的变化移动数据



对不起,如果这不是解释得太好,我是一个宏观新手,所以我不确定如果这是可能的。

我希望为一些简单的统计报告创建一个工作日表,每天自动创建一个新行,并删除最旧的,显示当前和前6天的数据。理想情况下,我希望当前日期在表的顶部,并且每天在相应行中输入的数据下移1行,为新一天的统计数据创建空间。

关于我想做的事情的一些背景信息…我基本上创建了一个友好的UI显示(离线HTML)的数据记录在一个非常简单的5列(统计)乘7行(工作日)表。这个数据库需要由多个技术能力有限的人更新,所以我基本上是想让他们尽可能容易地每天输入统计数据,而不必担心也要更新到正确的日期,并确保他们正在替换正确的日期数据等。从理论上讲,自动化每天更新表的过程,为他们输入当前日期的数据创建空间,将昨天的数据推到一行(如果整个表的单元格范围总是相同的,它应该允许我自动更新到脱机的HTML显示),这将是伟大的。

任何想法?

这应该可以让你开始:

Sub WeekdayTable()
Dim tbl As Range
Dim r As Integer
Set tbl = Range("A1:E7") 'Define your table, 5 columns x 7 rows. Modify as needed.
For r = tbl.Rows.Count To 2 Step -1
    tbl.Rows(r).Value = tbl.Rows(r - 1).Value
Next
'empty out row 1
tbl.Rows(1).Clear
'Assuming the column 1 contains valid DATE values, _
' we can use the DateAdd function to print the next date:
tbl.Cells(1, 1) = DateAdd("d", 1, tbl.Cells(2, 1))
End Sub

首先给出日期标题单元格的名称。(单击单元格。看看屏幕左上角出现单元格坐标的地方。"A1"、"B2"等等……在该文本框中,键入标题名称:"MyDateHeader"

然后,使用此宏(可以将其添加到工作簿打开事件或激活)

Sub YourMacro()
    Dim DateHeader As Range
    Set DateHeader = Range("MyDateHeader")
    Dim FirstDateCell As Range
    Set FirstDateCell = DateHeader.Offset(1, 0)

    Dim MyDay As Integer, MyMonth As Integer, MyYear As Integer
    Dim CurrDay As Integer, CurrMonth As Integer, CurrYear As Integer
    MyDay = Day(FirstDateCell.Value)
    MyMonth = Month(FirstDateCell.Value)
    MyYear = Year(FirstDateCell.Value)
    CurrDay = Day(Date)
    CurrMonth = Month(Date)
    CurrYear = Year(Date)

    If (MyDay <> CurrDay) Or (MyMonth <> CurrMonth) Or (MyYear <> CurrYear) Then
        FirstDateCell.EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
        DateHeader.Offset(1, 0).Value = Date 'Careful, FirstDateCell has moved down.
        DateHeader.Offset(8, 0).EntireRow.Clear
    End If
End Sub

最新更新