为条件格式/函数excel中的写入VBA代码

Question

SUB

ApplyConditonalFormatting

tom以通过列标头循环，如果标题包含某些文本，则将其变为（基于RGB比例）

1. 下颜色函数，然后用该颜色总和列中的所有整数 我尝试了以下内容并针对我的Excel表进行了调整，但它不起作用。我需要获得有条件的格式以先工作，然后执行sumcolor函数。我的语法或代码本身有问题吗？我想知道这是否是我的Excel表的设置方式，因为我在顶部有传奇/说明，并且标头直到第16行才开始。

Sub ApplyConditionalFormatting()
    Dim ws As Worksheet
    Dim targetText As String
    Dim cell As Range
    Dim startCell As Range
    Dim lastRow As Long
    
    ' Set the worksheet and target text
    Set ws = ThisWorkbook.Sheets("Sheet1")
    targetText = "TargetText"
    
    ' Find the cell containing the target text in column A
    Set startCell = ws.Columns("A").Find(What:=targetText, LookIn:=xlValues, LookAt:=xlWhole)
    
    ' If the target text is found
    If Not startCell Is Nothing Then
        ' Determine the last row in the column
        lastRow = ws.Cells(ws.Rows.Count, startCell.Column).End(xlUp).Row
        
        ' Apply the color to all cells below the found cell
        For Each cell In ws.Range(startCell.Offset(1, 0), ws.Cells(lastRow, startCell.Column))
            cell.Interior.Color = RGB(255, 255, 0) ' Yellow color
        Next cell
    Else
        MsgBox "Target text not found in column A."
    End If
End Sub

通过匹配的列

loop

Answer 1

格式格式化匹配标头（包含“ sum”），并总结下面的相应数据。

Sub HighlightAndSumupColumns()
    
    ' Define constants.
    Const SHEET_NAME As String = "Sheet1"
    Const FIRST_COLUMN As String = "A"
    Const FIRST_HEADER_TITLE As String = "TargetText"
    Const HEADER_CONTAINS_STRING As String = "Sum"
    Dim HEADER_COLOR As Long: HEADER_COLOR = vbYellow ' or = 'RGB(255,255,0)'
    
    ' Reference the workbook and worksheet.
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Sheets(SHEET_NAME)
    
    ' Reference the first cell of the header row.
    Dim fcell As Range: Set fcell = ws.Columns(FIRST_COLUMN) _
        .Find(What:=FIRST_HEADER_TITLE, LookIn:=xlFormulas, LookAt:=xlWhole)
    If fcell Is Nothing Then
        MsgBox "Could not find the title """ & FIRST_HEADER_TITLE _
            & """ in column """ & FIRST_COLUMN & """ of sheet """ _
            & ws.Name & """!", vbExclamation
        Exit Sub
    End If
    
    ' Reference the last cell of the header row.
    Dim lcell As Range: Set lcell = ws.Rows(fcell.Row) _
        .Find(What:="*", LookIn:=xlFormulas, SearchDirection:=xlPrevious)
    
    ' Reference the header row and clear existing highlights.
    Dim hrg As Range: Set hrg = ws.Range(fcell, lcell)
    hrg.Interior.ColorIndex = xlNone ' clear existing highlights
    
    ' Reference the data (below the headers).
    ' Assuming there is data, just data, below the headers!!!
    Dim drg As Range:
    With ws.UsedRange
        Set drg = hrg.Resize(.Rows.Count + .Row - hrg.Row - 1).Offset(1)
    End With
    
    ' Declare additional variables.
    Dim cell As Range, Col As Long, HeaderTitle As String, Total As Double
    
    ' Loop through the cells of the header row and highlight
    ' each matching header and sum up its corresponding data (below).
    For Each cell In hrg.Cells
        Col = Col + 1
        HeaderTitle = cell.Value
        If InStr(1, HeaderTitle, HEADER_CONTAINS_STRING, vbTextCompare) > 0 Then
            cell.Interior.Color = HEADER_COLOR
            ' If you also want to highlight the data, use:
            'drg.Columns(Col).Interior.Color = HEADER_COLOR
            Total = Total + Application.Sum(drg.Columns(Col))
            ' Assuming there are no error values!!!
        End If
    Next cell
    
    ' Inform.
    MsgBox "Headers highlighted. The sum is " & Total & ".", vbInformation

End Sub