Excel VBA实现：匹配值仅高亮第二行及日历节日匹配修正

实现思路 #

用字典记录已出现过的列值，遍历目标列时，若当前值已在字典中，则高亮当前单元格；若未出现，则将值存入字典。这样仅后出现的重复值会被高亮。

示例代码（假设目标列为A列） #

Sub HighlightDuplicatesLater()
    Dim ws As Worksheet
    Set ws = ActiveSheet ' 可替换为指定工作表，如ThisWorkbook.Worksheets("Sheet1")
    
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    Dim seenValues As Object
    Set seenValues = CreateObject("Scripting.Dictionary")
    
    Dim i As Long
    For i = 1 To lastRow
        Dim cellValue As Variant
        cellValue = ws.Cells(i, "A").Value
        
        If Not IsEmpty(cellValue) Then
            If seenValues.Exists(cellValue) Then
                ' 高亮当前单元格
                ws.Cells(i, "A").Interior.Color = vbYellow
            Else
                ' 将值存入字典
                seenValues.Add cellValue, i
            End If
        End If
    Next i
End Sub

说明 #

• 替换代码中的"A"为你需要检查的目标列字母。
• 字典seenValues确保每个值只记录第一次出现的位置，后续出现的相同值都会被高亮。

问题分析 #

现有代码仅通过B列的行值判断月份，但日历行可能包含跨月份的日期，导致其他月份的同日期单元格被误高亮。需要确保单元格日期所属月份与节日月份一致时才高亮。

修正代码（分两种场景） #

场景1：单元格存储完整日期（如2024/3/29）

如果日历单元格是完整的日期值，直接提取月份和日期与节日数组对比：

Sub HighlightHolidaysCorrectly()
    Dim ws1 As Worksheet
    Set ws1 = ActiveSheet ' 替换为你的目标工作表
    
    Dim last_row As Long
    last_row = ws1.Range("B1").End(xlDown).Row
    
    Dim row As Long, column As Long, i As Long
    
    For row = 1 To last_row
        For column = 3 To 9
            For i = 1 To num_holidays
                ' 跳过空单元格
                If Not IsEmpty(ws1.Cells(row, column).Value) Then
                    ' 对比单元格的月份、日期与节日数组
                    If Month(ws1.Cells(row, column).Value) = my_holidays(i, 1) And _
                       Day(ws1.Cells(row, column).Value) = my_holidays(i, 2) Then
                        ws1.Cells(row, column).Interior.Color = vbCyan
                    End If
                End If
            Next i
        Next column
    Next row
End Sub

场景2：单元格仅存储日数（如29），B列标记月份起始行

如果单元格只有日数，需先确定每行所属的月份范围，再判断日数是否属于该月份的节日：

Sub HighlightHolidaysCorrectly()
    Dim ws1 As Worksheet
    Set ws1 = ActiveSheet ' 替换为你的目标工作表
    
    Dim last_row As Long
    last_row = ws1.Range("B1").End(xlDown).Row
    
    ' 先收集各月份的起始行和对应月份值
    Dim monthStarts As Object
    Set monthStarts = CreateObject("Scripting.Dictionary")
    
    Dim i As Long
    For i = 1 To last_row
        If Not IsEmpty(ws1.Range("B" & i).Value) Then
            ' 存储月份值为键，起始行为值
            monthStarts.Add ws1.Range("B" & i).Value, i
        End If
    Next i
    
    Dim monthKeys As Variant, currentMonth As Integer, startRow As Integer, endRow As Integer
    monthKeys = monthStarts.Keys
    
    ' 遍历每个月份，确定其行范围并高亮对应节日
    For i = LBound(monthKeys) To UBound(monthKeys)
        currentMonth = monthKeys(i)
        startRow = monthStarts(currentMonth)
        
        ' 确定当前月份的结束行（下一个月份的起始行-1）
        If i < UBound(monthKeys) Then
            endRow = monthStarts(monthKeys(i + 1)) - 1
        Else
            endRow = last_row
        End If
        
        ' 遍历该月份的行和列
        Dim row As Long, column As Long, holidayIdx As Long
        For row = startRow To endRow
            For column = 3 To 9
                For holidayIdx = 1 To num_holidays
                    If my_holidays(holidayIdx, 1) = currentMonth And _
                       ws1.Cells(row, column).Value = my_holidays(holidayIdx, 2) Then
                        ws1.Cells(row, column).Interior.Color = vbCyan
                    End If
                Next holidayIdx
            Next column
        Next row
    Next i
End Sub

说明 #

• 场景2中，monthStarts字典会先收集所有标记了月份的起始行，再确定每个月份的行范围，仅在该范围内匹配对应月份的节日日期，避免跨月份误高亮。
• 确保my_holidays数组的月份值与B列的月份值格式一致（比如都是数字或都是中文名称）。

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