1

我想要做的是当一个单元格（A1）匹配一个命名范围（“名称”）中的某些东西时，它会改变颜色，但是如果它不匹配一个不同的命名范围（“眼睛”）那么它变成不同的颜色（有更多的范围，但我相信在我有两个工作之后我就能弄清楚）

注意事项：

我知道这可以通过条件格式来完成，但是由于命名范围的数量和范围的大小，我希望使用宏会更容易。

到目前为止，我已经设法让它适用于一个命名范围，并且当 A1 不是公式时（但是 A1 将是）

到目前为止，我的 2 段代码是（注意这是在 sheet1 下）：

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Address = "$A$1" Then
        Application.Run ("Colour")
    End If

End Sub

我的第二个（是一个单独的模块）：

Sub Colour()

    With ActiveSheet
        For Each c In .Range("Names").Cells

        If c.Value = .Range("A1").Value Then
            Range("A1").Select
            With Selection.Interior
                .Color = 5287936
            End With
        End If

        Next c
    End With

End Sub
4

1 回答 1

0

我认为这可以满足您的要求：

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("A1")) Is Nothing Then
    ApplyColor Me.Range("A1")
End If
End Sub

Sub ApplyColor(ValueRange As Range)
Dim MatchRanges As Variant
Dim MatchColors As Variant
Dim MatchValue As Variant
Dim i As Long

MatchRanges = Array("Names", "Eye")
MatchColors = Array(5287936, 4287952)
MatchValue = ValueRange.Value

ValueRange.Interior.Color = vbWhite
For i = LBound(MatchRanges) To UBound(MatchRanges)
    If WorksheetFunction.CountIf(Me.Range(MatchRanges(i)), MatchValue) > 0 Then
        ValueRange.Interior.Color = MatchColors(i)
        Exit For
    End If
Next i
End Sub

一些注意事项：“颜色”是 VBA 保留字，可能会导致问题，所以我为您的子名称使用了其他内容。在这种情况下您不需要使用Application.Run，只需使用子名称及其参数（或者Call如果您愿意）。

于 2013-07-08T04:03:54.017 回答