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

时间:2018-04-24 04:21:00

标签: vba excel-vba highlight excel

数据 Data

目的是根据列标题突出显示非日期单元格 (突出显示屏幕截图单元格C3,c5,D2,D6)

以下代码我尝试为此目的而工作但失败了。 请帮忙看看我能改变什么?

null pointer exception

4 个答案:

答案 0 :(得分: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

答案 1 :(得分:0)

试试这个(未经测试的)

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

答案 2 :(得分:0)

试试这个:

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

答案 3 :(得分:0)

  

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