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

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

3 个答案: