麻辣家族討論版版's Archiver

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

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=121131&ptid=23977]1#[/url] [i]cowww[/i] [/b]


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

執行結果:
[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

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=121135&ptid=23977]2#[/url] [i]Andy2483[/i] [/b]


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

變色前
[attach]36278[/attach]

變色後
[attach]36279[/attach]

Andy2483 發表於 2023-5-4 09:28

[i=s] 本帖最後由 Andy2483 於 2023-5-4 09:36 編輯 [/i]

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=121136&ptid=23977]3#[/url] [i]cowww[/i] [/b]


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

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


Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Target
   Dim xR As Range, xA As Range[b], xB As Range[/b]
   If .Columns.Count = Columns.CountLarge Then Exit Sub
   If .Count > 1 Or .Column = 1 [b]Or .Row = 1[/b] Then Exit Sub
   Set xR = .Cells: Set xA = Range([B1], Cells(1, Columns.Count)).EntireColumn
   [b]Set xB = Range([A2], Cells(Rows.Count, 1)).EntireRow[/b]
   With Intersect(ActiveSheet.UsedRange, xA[b], xB[/b])
      .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

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=121137&ptid=23977]4#[/url] [i]Andy2483[/i] [/b]

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

[attach]36284[/attach]

Andy2483 發表於 2023-5-4 10:30

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=121139&ptid=23977]5#[/url] [i]cowww[/i] [/b]


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

標題列在第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 [b].Row < 5[/b] Then Exit Sub
   Set xR = .Cells: Set xA = Range([B1], Cells(1, Columns.Count)).EntireColumn
   Set xB = Range([b][A5][/b], 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

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=121140&ptid=23977]6#[/url] [i]Andy2483[/i] [/b]

非常感謝Andy2483大大的解惑

成功了
[attach]36286[/attach]

cowww 發表於 2023-5-4 10:51

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=121140&ptid=23977]6#[/url] [i]Andy2483[/i] [/b]

可否請Andy2483大大解惑一下這段語法
小弟完全看不懂

准提部林 發表於 2023-5-4 10:55

[i=s] 本帖最後由 准提部林 於 2023-5-4 10:56 編輯 [/i]

這個填色方法//
1) 影響儲存格的原有底色(包含選取區的範圍)
2) 不能使用複製或還原功能

Andy2483 發表於 2023-5-4 11:14

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=121143&ptid=23977]8#[/url] [i]cowww[/i] [/b]


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

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

cowww 發表於 2023-5-4 12:47

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=121144&ptid=23977]9#[/url] [i]准提部林[/i] [/b]

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

以下是長官的要求
請問有辦法做一個類似button或是開關的功能
要使用變色功能的時候"開啟"
不要使用變色功能的時候"關掉"

准提部林 發表於 2023-5-4 12:59

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=121149&ptid=23977]11#[/url] [i]cowww[/i] [/b]


還要考慮整個活頁簿的全部工作表都有這功能~~

Andy2483 發表於 2023-5-4 13:04

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=121149&ptid=23977]11#[/url] [i]cowww[/i] [/b]


    If [B4] <> "燈號" Then Exit Sub

准提部林 發表於 2023-5-4 13:27

[i=s] 本帖最後由 准提部林 於 2023-5-4 13:41 編輯 [/i]

簡單範例//
用了一個選取物件//
兩個矩形(可放在資料區右方, 以不影響資料為主)...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

[i=s] 本帖最後由 Andy2483 於 2023-5-4 14:08 編輯 [/i]

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=121153&ptid=23977]14#[/url] [i]准提部林[/i] [/b]


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


Option Explicit
Sub 命名選取的圖片_名稱()
Selection.ShapeRange.Name = "矩形_橫"
End Sub
Sub 選取的圖片_名稱()
MsgBox Selection.ShapeRange.Name
End Sub

shuo1125 發表於 2023-5-4 13:57

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=121153&ptid=23977]14#[/url] [i]准提部林[/i] [/b]
准大這方式完全解決變色後的問題,直接用框線來標記真的厲害了...!

cowww 發表於 2023-5-4 14:21

[i=s] 本帖最後由 cowww 於 2023-5-4 14:23 編輯 [/i]

回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=121152&ptid=23977]13#[/url] [i]Andy2483[/i] [/b]

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

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

cowww 發表於 2023-5-4 15:14

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=121157&ptid=23977]17#[/url] [i]cowww[/i] [/b]

我把語法改成這樣
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

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=121158&ptid=23977]18#[/url] [i]cowww[/i] [/b]

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

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

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


[attach]36294[/attach]

cowww 發表於 2023-5-4 17:03

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=121160&ptid=23977]19#[/url] [i]Andy2483[/i] [/b]

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

有使用了准提部林大大提供的寫法及物件
真的很方便
但是為何勾選的物件無法改變大小及文字??

頁: [1] 2

麻辣家族討論版版為 麻辣學園 網站成員  由 昱得資訊工作室 © Since 1993 所提供