Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
If Application.CutCopyMode = xlCopy Then Me.Paste
On Error Resume Next
[colorCell].FormatConditions.Delete
Target.Name = "colorCell"
With [colorCell].FormatConditions ' 設定格式化條件
.Delete
.Add xlExpression, , "TRUE" ' 條件(一)內公式為
.Item(1).Interior.ColorIndex = 36 ' .Item(1)等於FormatConditions(1)
.Item(1).Font.Bold = True
End With
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim SelArea As Range
With Target
Set SelArea = Intersect([I7:O18], .Cells)
If SelArea Is Nothing Then Exit Sub
If .Address <> SelArea.Address Then Exit Sub
.Name = "colorcell"
End With
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set 範圍 = [C4:H10] '請自行更改要變色範圍，下面程式的顏色也自行更改
If Intersect(Target, 範圍) Is Nothing Then Exit Sub '選取範圍與設定範圍無交集則離開
範圍.Interior.ColorIndex = -4142 '先恢復無顏色
For Each rg In Target '逐一確認選取的範圍，若在設定範圍內則整列變色(選取的範圍有可能在設定範圍外)
If Not Intersect(rg, 範圍) Is Nothing Then Cells(rg.Row, 範圍(1).Column).Resize(, 範圍.Columns.Count).Interior.Color = RGB(100, 255, 255)
Next
Intersect(Target, 範圍).Interior.Color = RGB(255, 0, 0) '逐一確認選取的範圍，然後變色
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set 範圍 = [I7:O18] '請自行更改要變色範圍，下面程式的顏色也自行更改
If Intersect(Target, 範圍) Is Nothing Then Exit Sub '選取範圍與設定範圍無交集則離開
範圍.Interior.ColorIndex = -4142 '先恢復無顏色
For Each rg In Target '逐一確認選取的範圍，若在設定範圍內則整列變色(選取的範圍有可能在設定範圍外)
If Not Intersect(rg, 範圍) Is Nothing Then Cells(rg.Row, 範圍(1).Column).Resize(, 範圍.Columns.Count).Interior.Color = RGB(255, 255, 0)
If Not Intersect(rg, 範圍) Is Nothing Then Cells(範圍(1).Row, rg.Column).Resize(範圍.Rows.Count).Interior.Color = RGB(255, 255, 0)
Next
Intersect(Target, 範圍).Interior.Color = RGB(255, 0, 0) '確認選取的範圍，然後變色
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim xA As Range, SelArea As Range, xR As Range
Set xA = [I7:O18]: xA.Interior.ColorIndex = 0
Set SelArea = Intersect(xA, Target)
If SelArea Is Nothing Then Exit Sub
For Each xR In SelArea
xA.Rows(xR.Row - xA.Row + 1).Interior.Color = vbYellow
xA.Columns(xR.Column - xA.Column + 1).Interior.Color = vbYellow
Next
SelArea.Interior.Color = vbRed
End Sub作者: GBKEE 時間: 2018-12-10 15:41
湊一腳 參考看看
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim xA As Range, xR As Range
Set xA = [I7:O18]
xA.Interior.ColorIndex = 0
If Intersect(xA, Target) Is Nothing Then Exit Sub
For Each xR In xA.Columns
If Not Intersect(xR, Target) Is Nothing Then xR.Interior.Color = vbYellow
Next
For Each xR In xA.Rows
If Not Intersect(xR, Target) Is Nothing Then xR.Interior.Color = vbYellow
