如果单元格中的日期适用于今天,则宏显示弹出消息

时间:2018-10-03 14:44:13

标签: excel vba excel-vba

我在Excel中有一个任务列表,每次打开文件时都想要,并且有一个日期为今天的单元格,会弹出一条消息,其中包含今天要应用的任务

我尝试执行此代码,但是没有用

Private Sub Workbook_Open()
    For Each cell In Range("A4:A500")
        If cell.Value - today Then
            MsgBox "Here should be the text in column B"
        End If
    Next
End Sub

我将不胜感激

3 个答案:

答案 0 :(得分:2)

此示例有一个名为 list 的工作表:

enter image description here

此代码:

<div class="row  justify-content-center">
                        <div class="col-4 colMenu">
                             <h3>SAMPLE TEXT</h3>
                            <img src="./assets/img/sample.png"
class="menuImg">
                        </div>
                        <div class="col-4 colMenu ">
                                <h3 >SAMPLE TEXT</h3>
                               <img src="./assets/img/sample.png" class="menuImg">
                           </div>

                        <div class="w-100"></div>

                        <div class="col-4 colMenu ">
                        <h3>SAMPLE TEXT</h3>
                        <img src="./assets/img/sample.png" class="menuImg">
                           </div>
                           <div class="col-4 colMenu">
                                <h3 >SAMPLE TEXT</h3>
                               <img src="./assets/img/sample.png" class="menuImg">
                           </div>
                      </div>



.colMenu{
      border-style: solid;
      border-width: 3px;
      border-color: #000000;
  }

  .menuImg{
    height: 40%;
    margin-left: auto;
    margin-right: auto;
    display: block;
  }

将显示

注意:

  • 我们使用Private Sub Workbook_Open() For Each cell In Sheets("list").Range("A4:A500") If cell.Value = Date Then MsgBox cell.Offset(0, 1).Value End If Next cell End Sub 而不是Date()
  • 我们指定要检查的工作表
  • 我们使用Today()获取列 B 的内容

EDIT#1:

由于它是工作簿代码,因此非常容易安装和使用:

  1. 右键单击VBE左侧窗格中的Offset

enter image description here

  1. 选择查看代码
  2. 将内容粘贴并关闭VBE窗口

如果保存工作簿,则宏将随其一起保存。 如果您在2003年以后使用Excel版本,则必须保存 该文件为.xlsm而不是.xlsx

要删除宏,请执行以下操作:

  1. 如上所述调出VBE窗口
  2. 清除代码
  3. 关闭VBE窗口

要全面了解有关宏的更多信息,请参见:

http://www.mvps.org/dmcritchie/excel/getstarted.htm

http://msdn.microsoft.com/en-us/library/ee814735(v=office.14).aspx

要了解有关事件宏(工作簿代码)的更多信息,请参阅:

http://www.mvps.org/dmcritchie/excel/event.htm

必须启用宏才能使其正常工作!

答案 1 :(得分:0)

Sub Test()

TodayD = Date

'define sheet
With Worksheets(1).Range("A4:A500")
    Set c = .Find(Date, LookIn:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            MsgBox "Here should be the text in column B: " & firstAddress
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With

End Sub

答案 2 :(得分:0)

迟到总比不到好

Option Explicit
Sub TodaysTasks()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Description
  'In a specified worksheet or the ActiveSheet, searches a specified one column
  'range and looks for today's date values and when found writes the values of
  'the next adjacent column to a string and finally outputs the string to a
  'MsgBox and to the Immediate window.
'Arguments as constants
  'cStrWorksheetName
    'The name of the worksheet. If "" then the ActiveSheet object is used.
  'cStrRange
    'The range where to search.
  'cStrTitle
    'The title of the resulting string
'Results
  'A string containing the title and the matching values of the second column.

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Customize BEGIN -----------------------
  Const cStrWorksheetName = "" 'Worksheet name. If "" then ActiveSheet.
  Const cStrRange = "A4:A500"
  Const cStrTitle = "My today's tasks"
'Customize END -------------------------

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  Dim oWb As Workbook
  Dim oWs As Worksheet
  Dim rRng As Range
  Dim loF1 As Long 'Rows Counter
  Dim strTasks As String

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  Set oWb = ActiveWorkbook
  If cStrWorksheetName = "" Then
    Set oWs = oWb.ActiveSheet
   Else
    Set oWs = oWb.Worksheets(cStrWorksheetName)
  End If
  Set rRng = oWs.Range(cStrRange)
  'Set the title
  strTasks = cStrTitle & vbCrLf

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  'Loop through all cells (rows) in first column.
  For loF1 = 1 To oWs.Range(cStrRange).Rows.Count
  'Check if value in first column is todays date.
    If rRng(loF1, 1).Value = Date Then 'It is today's date.
      'Write value in second column to the string.
      strTasks = strTasks & vbCrLf & rRng(loF1, 2).Value
'     Else 'It is not today's date.
      'skip the row
    End If
  Next

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  MsgBox strTasks
  Debug.Print strTasks

End Sub