在Excel中比較表列與當前日期VBA

Question

我想寫一個excel VBA來比較一個表與當前日期的列，並突出顯示如果是true。

下面是一個例子表：

是我工作的代碼是：

Private Sub Workbook_Open() 
    Dim tbl As Excel.ListObject 'Table name 
    Dim lr As Excel.ListRow 'Row index 
    Dim ws As Excel.Worksheet 'Work sheet 
    'column names 
    Dim keepInTouch As Range, invite As Range, present As Range, follow As Range 

    Set ws = ThisWorkbook.Worksheets(1)         'select work book index 1 
    Set tbl = ws.ListObjects("ContactList")        'set ContactList to tbl 
    Set keepInTouch = tbl.ListColumns("Keep in Touch").DataBodyRange 'Select the appropreate header 
    Set invite = tbl.ListColumns("Invite").DataBodyRange 
    Set present = tbl.ListColumns("Present").DataBodyRange 
    Set follow = tbl.ListColumns("Follow").DataBodyRange 
    'MsgBox tbl 
    For Each lr In tbl.ListRows 
     If lr.Range(1, tbl.ListColumns("Keep in Touch").Index).Value <> Date Then 
      keepInTouch.Interior.ColorIndex = xlNone 
      keepInTouch.Font.ColorIndex = 1 
      keepInTouch.Font.Bold = False 
     'If keepInTouch(1).Value = Date And keepInTouch(1).Value <> "" Then 
     ElseIf lr.Range(1, tbl.ListColumns("Keep in Touch").Index).Value = Date Then 
      keepInTouch.Interior.ColorIndex = 3 
      keepInTouch.Font.ColorIndex = 2 
      keepInTouch.Font.Bold = True 
     End If 
     Next lr 
End Sub 

第19行：If keepInTouch.Index = Date And keepInTouch.Index <> "" Then導致

Run time error '438': 
Object doesn't support this property or method. 

是什麼這樣做的正確方法？

Answer 1

If lr.Range(1, tbl.ListColumns("Keep in Touch").Index).Value = Date Then 

例如lr.Range(1, 2)處於ListRow範圍

keepInTouchIndex = tbl.ListColumns("Keep in Touch").Index 
NameIndex = tbl.ListColumns("Name").Index 

For Each lr In tbl.ListRows 
    With lr.Range.Cells(1, NameIndex) 
     If lr.Range.Cells(1, keepInTouchIndex).Value <> Date Then 
      .Interior.ColorIndex = 3 
      .Font.ColorIndex = 2 
      .Font.Bold = True 
     Else 
      .Interior.ColorIndex = xlNone 
      .Font.ColorIndex = 1 
      .Font.Bold = False 
     End If 
    End With 
Next lr