2013-07-08 146 views
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 

回答

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保留字,並可能導致的問題,所以我用別的東西你的子名。 (如果你喜歡或Call)你不需要在這種情況下使用Application.Run,剛子的名字和它的參數。

+0

不喜歡你的我在Me.Range在18行所以我改變了對工作表(「工作表Sheet1」)。範圍,現在工作得很好。感謝您的幫助:D – TinyTim

相關問題