VBA - 生日前 10 天的 msgbox答案

【问题标题】：VBA - msgbox 10 days before a birthdayVBA - 生日前 10 天的 msgbox
【发布时间】：2016-05-24 19:57:36
【问题描述】：

在 B 列的工作表 1 中，我有名字在 D 列的工作表 1 中，我有生日日期

B:
Ben
Mikael

D:
3 MARCH 1987
3 JUNE 1976

我想找到一个 VBA 脚本来制作一个弹出消息框并打印出“距离 NAME（来自 B 列）生日还有 10 天或更短时间”。

如何做到这一点？

【问题讨论】：

因此，如果此人出生于 1948 年 1 月 5 日，您希望下一条消息发布于 2016 年 12 月 26 日 ??
确切地说，在这个人过生日的前 10 天。就像对 Excel 文档的用户提前 10 天发出警告一样。它需要用vba编写
是的，可以做到。您可以使用 Outlook 或一个不错的日历程序为您执行此操作。或者，您可以编写一个宏来检查日期，并在距离日期不到 10 天时发出警告。缺点是您必须每天打开此 Excel 文件才能运行宏。或者你可以使用Application.OnTime，永远不要关闭你的电脑，永远不要关闭 Excel。
"它需要用 vba 编写" - 为什么？？？等等，你不会指望我们免费为你做你的家庭作业/工作吧？
你有几个名字？我的意思是，如果你需要对 1000 人发出警告，会发生什么？你想怎么处理？ 1000 个消息框？ 1 长的有 1000 个名字？

标签： excel vba msgbox

【解决方案1】：

在E1中输入：

=DATE(YEAR(D1)+DATEDIF(D1,TODAY(),"y")+1,MONTH(D1),DAY(D1))

然后抄下来。然后在 F1 中输入：

=E1-TODAY()

然后抄下来。

E 列是即将到来的生日，F 列是距离下一个生日的天数。

最后在工作表代码区，输入如下事件宏：

Private Sub Worksheet_Activate()
    Dim cel As Range, F As Range

    Set F = Intersect(ActiveSheet.UsedRange, Range("F:F"))
    For Each cel In F
        If cel.Value < 11 Then
            MsgBox cel.Offset(0, -4).Value & " will have a birthday in " & cel.Value & " days"
        End If
    Next cel
End Sub

只要激活工作表，您就会收到消息：

【讨论】：

快速阅读您的帖子后。我是对的，您首先计算了距下一个生日还有多少天。然后在 VBA 脚本中告诉消息如果值是 10 或更少则弹出？
你是对的！......我使用了类似的东西，但我使用条件格式而不是宏来突出显示名称。
无法确定这种方式是否比我的方式更好（下）。比我在代码中做的有什么缺点吗？
@Behedwin 如果您对自己的代码感到满意，请使用它......我喜欢我的方法，因为我可以看到所有人和生日有多近。

【解决方案2】：

我想我找到了一种方法来做我想做的事。

谢谢你的好意。

下面是我开始工作的代码。但要让它起作用，我必须首先获取生日并将其分为三个单元格，即日、月和年。然后我再次结合日月而不是年份，而是使用年份（now（））并获得今年的生日。

然后我可以使用下面的代码通过 dateadd 添加 1-10 天。

这感觉有点笨拙......但到目前为止我认为它会起作用。

Sub checkearlybirthday()
Dim ans As String
Dim cell As Range

For Each cell In Sheets("Personal").Range("rf10:rf500")
    If cell = DateAdd("d", 1, Date) Or cell = DateAdd("d", 2, Date) Or cell = DateAdd("d", 3, Date) Or cell = DateAdd("d", 4, Date) Or cell = DateAdd("d", 5, Date) Or cell = DateAdd("d", 6, Date) Or cell = DateAdd("d", 7, Date) Or cell = DateAdd("d", 8, Date) Or cell = DateAdd("d", 9, Date) Or cell = DateAdd("d", 10, Date) Then
        ans = ans & vbNewLine & Sheets("Personal").Cells(cell.Row, 2).Value
    End If
Next

If Len(ans) < 1 Then

Else
    MsgBox "Hallå! " & vbNewLine & "Det är 10 dagar eller mindre till dessa fyller år. " & ans & "  " & vbNewLine & ""
End If

结束子

【讨论】：