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

Posted 2023-03-06

【中文标题】根据列标题和日期格式突出显示单元格

【英文标题】：highlight cell based on column header and date format

【发布时间】：2018-10-04 05:24:21

【问题描述】：

数据

目的是根据列标题突出显示非日期单元格。 （高亮屏幕截图单元格 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

【参考方案1】：

或者

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

【讨论】：

这段代码如何"高亮屏幕截图单元格C3,c5,D2,D6"？

假设他们在按标题搜索时犯了一个错误，并且他们的原始代码在一列的基础上工作。我添加了一个也涵盖此场景的编辑。

OP的问题对我来说很清楚“目的是根据列标题突出显示非日期单元格。（突出显示截图单元格C3，c5，D2，D6）”，屏幕截图标题有不止一个“日期”出现，最后 OP 说 “下面的代码我尝试为此目的工作但失败了”。他一定是非常错了

但只有一个 Cut Date 标题是他们要搜索的。所以基于 Header 只有一个匹配而不是两个。

既然 OP 接受了你的答案，它必须是正确的

【参考方案2】：

目的是根据列标题突出显示非日期单元格。 （高亮屏幕截图单元格 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

【参考方案3】：

试试这个（未经测试）

---

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

【参考方案4】：

试试这个：

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