单击一个单元格并更改相同颜色的所有单元格

Question

我目前正在制作一个日历，其中有些日子（每个单独的单元格）有绿色、蓝色和其他红色背景

我希望能够单击给定范围内的一个单元格（日历中的一天）。如果该单元格具有特定的背景颜色，我希望该范围内所有其他相同颜色的单元格都可以更改，并且文本为粗体。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Cancel = True

    Dim cell As Range
    Dim Rng As Range
    Set Rng = ActiveWorkbook.Sheets("Tickets").Range("N11:AW20")

    For Each cell In Rng

    If Target.Interior.ColorIndex = 37 Then
        Target.Font.Bold = True
    End If

    Exit For

    Next cell

End Sub

到目前为止，目标单元格的文本变为粗体，但该范围内的其余单元格没有变为粗体。

如何让 excel 扫描范围的其余部分并应用更改？

PS：最初我希望在将鼠标悬停在单元格上时触发宏，但我找不到任何这样做的方法。

这是带有日历的文件，可让您更好地了解整个事情。

https://drive.google.com/file/d/17tveiFHu4nlw47jqmXixIQoe6j7iOTe-/view?usp=sharing

提前致谢！

Answer 1

如果您将此代码放入带有日历的工作表的模块中，它应该会激活日历范围中与当前选择具有相同背景颜色的每个单元格。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim rngCalendar As Range
    Set rngCalendar = Range("N11:AW20")

    If Not Intersect(Target, rngCalendar) Is Nothing Then

        SpeedUp True

        rngCalendar.Font.Bold = False

        Dim cel As Range
        For Each cel In rngCalendar
            If cel.Interior.ColorIndex = Target.Interior.ColorIndex Then
                cel.Font.Bold = True
            End If
        Next cel

        SpeedUp False

    End If

End Sub

Private Function SpeedUp(ByVal toggleOn As Boolean)

    With Application
        .Calculation = IIf(toggleOn, xlCalculationManual, xlCalculationAutomatic)
        .ScreenUpdating = Not toggleOn
        .EnableEvents = Not toggleOn
    End With

End Function

Answer 2

问题是你的循环实际上并没有对它所在的单元格做任何事情。

你可以把它改成这样的

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True

Dim cell As Range
Dim Rng As Range
Set Rng = ActiveWorkbook.Sheets("Tickets").Range("N11:AW20")

    If target.Interior.Colorindex = 37 then

     For Each cell In Rng

         If cell.Interior.ColorIndex = 37 Then
           cell.Font.Bold = True
         End If

    Next cell

    End if

End Sub

Answer 3

我认为它应该有所帮助:)

Dim cell As Range
Dim Rng As Range
Dim status As Integer
Set Rng = ActiveWorkbook.Sheets("Tickets").Range("N11:AW20")

For Each cell In Rng
    If Target.Interior.ColorIndex = 37 Then
        Target.Font.Bold = True
        status = 1
        Exit For
    End If

Next cell
If status = 1 Then
    Rng.Interior.ColorIndex = 37
    Rng.Font.Bold = True
End If