Board logo

標題: [發問] 選擇單元格時欄列變色 [打印本頁]
作者: cowww    時間: 2023-5-3 17:49     標題: 選擇單元格時欄列變色

[attach]36271[/attach]

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
    On Error Resume Next
     If Target.Count > 1 Then Exit Sub
    Cells.FormatConditions.Delete
   
With Target.EntireColumn.FormatConditions  '欄變色
        .Delete
        .Add xlExpression, , "TRUE"
        .Item(1).Interior.ColorIndex = Int(28)
    End With
   
With Target.EntireRow.FormatConditions  '列變色
        .Delete
        .Add xlExpression, , "TRUE"
        .Item(1).Interior.ColorIndex = Int(35)
    End With
   
With Target.FormatConditions  '單元格變色
        .Delete
        .Add xlExpression, , "TRUE"
        .Item(1).Interior.ColorIndex = Int(4)
    End With
End Sub

各位大大
小弟為了方便辨識目前的看哪個欄列，上網去找了"選擇單元格時欄列變色"的語法
確實是有達到我要的效果
但是
燈號那個欄位卻不見了

[attach]36272[/attach]

請問上面那段語法哪裡寫錯，煩請知道的大大們幫助小弟解惑
作者: Andy2483    時間: 2023-5-4 08:13

回復 1# cowww


    謝謝前輩發表此主題
後學研習方案如下,請前輩參考

執行結果:
[attach]36277[/attach]


Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Target
   Dim xR As Range, xA As Range
   If .Columns.Count = Columns.CountLarge Then Exit Sub
   If .Count > 1 Or .Column = 1 Then Exit Sub
   Set xR = .Cells: Set xA = Range([B1], Cells(1, Columns.Count)).EntireColumn
   With Intersect(ActiveSheet.UsedRange, xA)
      .Interior.ColorIndex = xlNone
      Intersect(xR.EntireRow, .Cells).Interior.ColorIndex = 6
      Intersect(xR.EntireColumn, .Cells).Interior.ColorIndex = 6
   End With
   .Interior.ColorIndex = 4
End With
End Sub
作者: cowww    時間: 2023-5-4 08:53

回復 2# Andy2483


非常感謝Andy2483大大的解惑
但是
搞定了列位，變成欄位的原來顏色不見了

變色前
[attach]36278[/attach]

變色後
[attach]36279[/attach]
作者: Andy2483    時間: 2023-5-4 09:28

本帖最後由 Andy2483 於 2023-5-4 09:36 編輯

回復 3# cowww


    謝謝前輩回復
後學學習方案如下,請前輩參考

執行結果:
[attach]36280[/attach]


Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Target
   Dim xR As Range, xA As Range, xB As Range
   If .Columns.Count = Columns.CountLarge Then Exit Sub
   If .Count > 1 Or .Column = 1 Or .Row = 1 Then Exit Sub
   Set xR = .Cells: Set xA = Range([B1], Cells(1, Columns.Count)).EntireColumn
   Set xB = Range([A2], Cells(Rows.Count, 1)).EntireRow
   With Intersect(ActiveSheet.UsedRange, xA, xB)
      .Interior.ColorIndex = xlNone
      Intersect(xR.EntireRow, .Cells).Interior.ColorIndex = 6
      Intersect(xR.EntireColumn, .Cells).Interior.ColorIndex = 6
   End With
   .Interior.ColorIndex = 4
End With
End Sub
作者: cowww    時間: 2023-5-4 10:15

回復 4# Andy2483

非常感謝Andy2483大大的解惑
欄位的背景顏色還是會消失
[attach]36283[/attach]

[attach]36284[/attach]
作者: Andy2483    時間: 2023-5-4 10:30

回復 5# cowww


    謝謝前輩再回復,謝謝論壇
後學學習方案如下,請前輩參考

標題列在第4列,執行結果:
[attach]36285[/attach]


Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Target
   Dim xR As Range, xA As Range, xB As Range
   If .Columns.Count = Columns.CountLarge Then Exit Sub
   If .Count > 1 Or .Column = 1 Or .Row < 5 Then Exit Sub
   Set xR = .Cells: Set xA = Range([B1], Cells(1, Columns.Count)).EntireColumn
   Set xB = Range([A5], Cells(Rows.Count, 1)).EntireRow
   With Intersect(ActiveSheet.UsedRange, xA, xB)
      .Interior.ColorIndex = xlNone
      Intersect(xR.EntireRow, .Cells).Interior.ColorIndex = 6
      Intersect(xR.EntireColumn, .Cells).Interior.ColorIndex = 6
   End With
   .Interior.ColorIndex = 4
End With
End Sub
作者: cowww    時間: 2023-5-4 10:49

回復 6# Andy2483

非常感謝Andy2483大大的解惑

成功了
[attach]36286[/attach]
作者: cowww    時間: 2023-5-4 10:51

回復 6# Andy2483

可否請Andy2483大大解惑一下這段語法
小弟完全看不懂
作者: 准提部林    時間: 2023-5-4 10:55

本帖最後由 准提部林 於 2023-5-4 10:56 編輯

這個填色方法//
1) 影響儲存格的原有底色(包含選取區的範圍)
2) 不能使用複製或還原功能
作者: Andy2483    時間: 2023-5-4 11:14

回復 8# cowww


    謝謝論壇,謝謝各位前輩,請各位前輩指教

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Target
'↑以下是關於觸發的程序
   Dim xR As Range, xA As Range, xB As Range
   '↑宣告(xR,xA,xB)是 儲存格變數
   If .Columns.Count = Columns.CountLarge Then Exit Sub
   '↑如果觸發欄數是 最大欄數!就結束程式執行
   If .Count > 1 Or .Column = 1 Or .Row < 5 Then Exit Sub
  '↑如果觸發格數大於1 或 觸發欄位數是1(A欄) 或觸發列號小於 5!就結束程式執行
   Set xR = .Cells: Set xA = Range([B1], Cells(1, Columns.Count)).EntireColumn
   '↑令xR這儲存格變數是 觸發的儲存格
   '↑令xA這儲存格變數是 ([B1]到 第1列最後欄範圍存格)所在欄的全部儲存格
   Set xB = Range([A5], Cells(Rows.Count, 1)).EntireRow
   '↑令xB這儲存格變數是 ([A5]到 A欄最後列範圍存格)所在列的全部儲存格
   With Intersect(ActiveSheet.UsedRange, xA, xB)
   '↑以下是關於三個儲存格區域交集後的儲存格區域 程序
   '1.本表有使用的儲存格 :2.xA變數 :3.xB變數
      .Interior.ColorIndex = xlNone
      '↑令此區域儲存格底色是 無色
      Intersect(xR.EntireRow, .Cells).Interior.ColorIndex = 6
      '↑令觸發格所在此區域儲存格列底色是 黃色
      Intersect(xR.EntireColumn, .Cells).Interior.ColorIndex = 6
      '↑令觸發格所在此區域儲存格欄底色是 黃色
   End With
   .Interior.ColorIndex = 4
   '↑令觸發格底色是 綠色
End With
End Sub
作者: cowww    時間: 2023-5-4 12:47

回復 9# 准提部林

長官說很卡
他說平常不會用到變色的功能
只有報告或開會的時候才會使用

以下是長官的要求
請問有辦法做一個類似button或是開關的功能
要使用變色功能的時候"開啟"
不要使用變色功能的時候"關掉"
作者: 准提部林    時間: 2023-5-4 12:59

回復 11# cowww


還要考慮整個活頁簿的全部工作表都有這功能~~
作者: Andy2483    時間: 2023-5-4 13:04

回復 11# cowww


    If [B4] <> "燈號" Then Exit Sub
作者: 准提部林    時間: 2023-5-4 13:27

本帖最後由 准提部林 於 2023-5-4 13:41 編輯

簡單範例//
用了一個選取物件//
兩個矩形(可放在資料區右方, 以不影響資料為主)...Range("M1")..可自行更改
若其它工作表也要同樣功能, 將Selection_Change程式及那三個物件複製即可(注意:物件名稱)

[attach]36287[/attach]


補充//為了防止選取區不在使用範圍內的錯誤, 修改如下
Set X = Intersect(Selection.EntireRow, ActiveSheet.UsedRange)
If X Is Nothing Then Exit Sub
Set Y = Intersect(Selection.EntireColumn, ActiveSheet.UsedRange)
If Y Is Nothing Then Exit Sub
作者: Andy2483    時間: 2023-5-4 13:52

本帖最後由 Andy2483 於 2023-5-4 14:08 編輯

回復 14# 准提部林


    謝謝前輩指導不變更格式凸顯焦點儲存格的方式


Option Explicit
Sub 命名選取的圖片_名稱()
Selection.ShapeRange.Name = "矩形_橫"
End Sub
Sub 選取的圖片_名稱()
MsgBox Selection.ShapeRange.Name
End Sub
作者: shuo1125    時間: 2023-5-4 13:57

回復 14# 准提部林
准大這方式完全解決變色後的問題，直接用框線來標記真的厲害了...!
作者: cowww    時間: 2023-5-4 14:21

本帖最後由 cowww 於 2023-5-4 14:23 編輯

回復 13# Andy2483

非常感謝准提部林大大提供的新寫法
我可能要研究一段時間才能看得懂

非常感謝Andy2483大大的解惑
我現在有一個問題
將變色關掉的時候，已變色的單元格+欄位+列位不會消失
就算關掉變色去點選其他單元格也不會消失
請問這個問題有辦法解決嗎??
[attach]36289[/attach]
作者: cowww    時間: 2023-5-4 15:14

回復 17# cowww

我把語法改成這樣
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

With Target
   Dim xR As Range, xA As Range, xB As Range
   If .Columns.Count = Columns.CountLarge Then Exit Sub
   If .Count > 1 Or .Column = 1 Or .Row < 5 Then Exit Sub
   Set xR = .Cells: Set xA = Range([B1], Cells(1, Columns.Count)).EntireColumn
   Set xB = Range([A5], Cells(Rows.Count, 1)).EntireRow
   With Intersect(ActiveSheet.UsedRange, xA, xB)
      .Interior.ColorIndex = xlNone
      If Range("F2") = "N" Then
                Intersect(xR.EntireRow, .Cells).Interior.ColorIndex = 0
                Intersect(xR.EntireColumn, .Cells).Interior.ColorIndex = 0
                .Interior.ColorIndex = 0
            Else
                Intersect(xR.EntireRow, .Cells).Interior.ColorIndex = 6
                Intersect(xR.EntireColumn, .Cells).Interior.ColorIndex = 6
                  End If
        End With
            .Interior.ColorIndex = 4
    End With
End Sub

變色選擇"YES"
[attach]36290[/attach]

變色選擇"NO"
[attach]36291[/attach]

有辦法把"NO"的單元個底色變成 無色 嗎?
作者: Andy2483    時間: 2023-5-4 16:03

回復 18# cowww

用 准提部林前輩的範例 紅框線改成黃透明填滿
推薦使用此方法,不會變動到儲存格格式

情境1:
[attach]36292[/attach]

情境2:
[attach]36293[/attach]


[attach]36294[/attach]
作者: cowww    時間: 2023-5-4 17:03

回復 19# Andy2483

非常感謝准提部林大大的解惑
非常感謝Andy2483大大的解惑

有使用了准提部林大大提供的寫法及物件
真的很方便
但是為何勾選的物件無法改變大小及文字??
作者: Andy2483    時間: 2023-5-5 07:52

回復 20# cowww


    謝謝前輩回復
Sorry
後學研究很久,搞不懂如何改變核取方塊字體大小.....
請前輩再爬文研究看看



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)