Vergleichen Sie Tabellenspalten mit dem aktuellen Datum in Excel VBA

Question

Ich versuche, eine Excel-VBA zu schreiben, um Spalten einer Tabelle mit dem aktuellen Datum zu vergleichen und wenn wahr zu markieren. Hier

ist ein Beispiel Tabelle:

Der Code, der ich arbeite ist:

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 

Linie 19: If keepInTouch.Index = Date And keepInTouch.Index <> "" Then

verursacht

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

Was ist der richtige Weg, dies zu tun?

Answer 1

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

Zum Beispiel lr.Range(1, 2) ist die zweite Spalte Zelle in der ListRow Bereich

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