如何在现有Excel VBA代码中添加基于其他单元格颜色修改单元格颜色的功能

Hey there! Awesome that your existing code for flagging unique values per row is working smoothly for your 100-row sheet. Let's build on that to add the color-matching functionality you're after—whether you want to sync the fill color or font color from a reference cell to your unique value cells, here's a straightforward implementation:

Modified VBA Code with Color Matching #

Sub HighlightUniqueValuesWithColorMatch()
    Dim ws As Worksheet
    Dim lastRow As Long, lastCol As Long
    Dim currentRow As Long, currentCol As Long
    Dim cellValue As Variant
    Dim valueCount As Integer
    Dim referenceCol As Integer ' Column number of the cell whose color we want to match
    Dim applyToFont As Boolean ' Set to True to match font color, False for fill color
    
    ' --- Customize these settings to fit your sheet ---
    Set ws = ThisWorkbook.Worksheets("Sheet1") ' Replace with your sheet name
    referenceCol = 1 ' Example: Use column A (1) as the reference color source
    applyToFont = True ' Change to False if you want to match fill color instead
    ' --- End customization ---
    
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' Assume data starts at column A
    lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column ' Get last column with data
    
    ' Loop through each row
    For currentRow = 2 To lastRow ' Start at row 2 if row 1 is headers
        ' Loop through each cell in the row
        For currentCol = 1 To lastCol
            cellValue = ws.Cells(currentRow, currentCol).Value
            If cellValue <> "" Then ' Skip empty cells
                ' Count occurrences of the value in the current row
                valueCount = Application.WorksheetFunction.CountIf(ws.Rows(currentRow), cellValue)
                
                ' If it's a unique value
                If valueCount = 1 Then
                    ' Get the color from the reference cell in this row
                    Dim targetColor As Long
                    If applyToFont Then
                        targetColor = ws.Cells(currentRow, referenceCol).Font.Color
                    Else
                        targetColor = ws.Cells(currentRow, referenceCol).Interior.Color
                    End If
                    
                    ' Apply the color to the unique value cell
                    If applyToFont Then
                        ws.Cells(currentRow, currentCol).Font.Color = targetColor
                    Else
                        ws.Cells(currentRow, currentCol).Interior.Color = targetColor
                    End If
                Else
                    ' Optional: Reset color for non-unique values (adjust as needed)
                    If applyToFont Then
                        ws.Cells(currentRow, currentCol).Font.Color = vbBlack
                    Else
                        ws.Cells(currentRow, currentCol).Interior.Color = xlNone
                    End If
                End If
            End If
        Next currentCol
    Next currentRow
    
    MsgBox "Unique values highlighted with matched colors!", vbInformation
End Sub

Key Customization Tips #

• Sheet Name: Replace "Sheet1" with your actual worksheet name.
• Reference Column: Change referenceCol = 1 to the column number you want to pull color from (e.g., 2 for column B, 3 for column C).
• Color Type: Set applyToFont = True if you want the unique value's font color to match the reference cell's font color. Set it to False if you want to match the reference cell's fill (background) color instead.
• Header Row: If your data starts at row 1 (no headers), change For currentRow = 2 To lastRow to For currentRow = 1 To lastRow.

How It Works #

1. The code first loops through each row in your data range.
2. For each cell, it checks if the value is unique in that row using CountIf.
3. When a unique value is found, it grabs the color (font or fill) from the specified reference column in the same row.
4. It applies that color to the unique value cell, and optionally resets non-unique values to default colors.

This should integrate seamlessly with your existing workflow—just tweak the settings to match your exact needs, and run the macro like you did before!

内容的提问来源于stack exchange，提问作者Katherine Reed