根据列 header 和日期格式突出显示单元格

Question

数据

目的是突出显示基于列 header 的非日期单元格。
（突出显示屏幕截图单元格 C3、c5、D2、D6）

下面的代码我尝试为此目的工作但失败了。能帮忙看看我能改什么吗？

Sub colortest()
    Dim MyPage As Range, currentCell As Range

    With Sheets(2).Rows(1)
        Set t = .Find("Cut Date", lookat:=xlPart)
        Set A = Columns(t.Column).EntireColumn

        For Each currentCell In A
            If Not IsEmpty(currentCell) Then
                Select Case Not IsDate(currentCell.Value)
                    Case 1
                        currentCell.Interior.Color = 56231
                End Select
            End If
        Next currentCell
    End With
End Sub

Answer 1

试试这个（未测试）

Option Explicit

Public Sub ColorTest1()
    Dim ur As Range, hdrRow As Range, hdr As Range, dtCol As Range, cel As Range

    Set ur = ThisWorkbook.Worksheets(2).UsedRange

    Application.ScreenUpdating = False
    Set hdrRow = ur.Rows(1)
    For Each hdr In hdrRow.Cells
        If InStr(1, hdr.Value2, "date", vbTextCompare) > 0 Then     '<- Date Header
            Set dtCol = ur.Columns(hdr.Column).Offset(1)            '<- Date column
            For Each cel In dtCol.Cells
                If Len(cel) > 0 Then            'If cell is not empty
                    If Not cel Is Error Then    'If not Error (#N/A, #REF!, #NUM!, etc)
                        If Not IsDate(cel) Then cel.Interior.Color = 56231
                    End If
                End If
            Next
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Answer 2

或者

Option Explicit

Public Sub colortest()
    Dim MyPage As Range, currentCell As Range, t As Range, findString As String
    findString = "Date"

    With ThisWorkbook.Worksheets("Sheet2")

        Set t = .Rows(1).Find(findString, LookAt:=xlPart)

        Dim currMatch As Long

        For currMatch = 1 To WorksheetFunction.CountIf(.Rows(1).Cells, "*" & findString & "*")

            Set t = Rows(1).Find(What:=findString, After:=t, _
                                 LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, _
                                 SearchDirection:=xlNext, MatchCase:=False)

            If t Is Nothing Then Exit Sub

            For Each currentCell In Intersect(.Columns(t.Column), .UsedRange.Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count).Offset(1, 0))
                If Not IsEmpty(currentCell) And Not IsDate(currentCell.Value) Then currentCell.Interior.Color = 56231
            Next currentCell

        Next currMatch
    End With
End Sub

Answer 3

试试这个：

Sub HighlightNonDate()
    'simple function invocations
    CheckColumn (3)
    CheckColumn (4)
End Sub

Function CheckColumn(columnNumber As Long)
    Dim lastRow As Long
    lastRow = Cells(Rows.Count, columnNumber).End(xlUp).Row
    'loop through column, start from 2 to omit headers
    For i = 2 To lastRow
        'if cell isn't a date, then color red
        If Not IsDate(Cells(i, columnNumber)) Then
            Cells(i, columnNumber).Interior.Color = RGB(255, 0, 0)
        End If
    Next
End Function

Answer 4

Purpose is to highlight the non date cell based on column header. (highlight the screenshot cell C3,c5,D2,D6)

这样做可以：

Sub colortest()
    Dim currentCell As Range, f As Range
    Dim fAddress As String

    With Sheets(2).Rows(1)
        Set f = .Find(what:="Date", lookat:=xlPart, LookIn:=xlValues)
        If Not f Is Nothing Then
            fAddress = f.Address
            Do
                With Intersect(f.EntireColumn, .Parent.UsedRange)
                    For Each currentCell In .Resize(.Rows.count - 1).Offset(1).SpecialCells(xlCellTypeConstants, xlTextValues)
                        If Not IsDate(currentCell.Value) Then currentCell.Interior.Color = 56231
                    Next
                End With
                Set f = .FindNext(f)
            Loop While f.Address <> fAddress
        End If
    End With
End Sub

根据列 header 和日期格式突出显示单元格

highlight cell based on column header and date format

excel

vba

highlight