Board logo

標題: [發問] VBA點選儲存格指定範圍自動反色 [打印本頁]

作者: msmplay    時間: 2017-2-24 22:28     標題: VBA點選儲存格指定範圍自動反色

[attach]26718[/attach]
以下程式碼是在網路上找到的,但想請教該如何修改成以下想要的條件呢?
1. 希望反色條件只在I7:O18有作用,且改以整列反色呈現。例如:點選K9時,I9:O9會整列反色、點選N15時,I15:O15整列反色
2. 發現使用此VBA之後無法複製貼上或剪下貼上,例如當我複製B7後,只要滑鼠點選任何儲存格欲貼上時,複製的選項就會消失。剪下欲貼上的功能亦相同
以上求解~~~~~~~

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



[attach]26719[/attach]
作者: lpk187    時間: 2017-2-25 00:12

回復 1# msmplay


   看起來好像複雜化了,若只有點選反白只要如下代碼即可
  1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  2. If Target.Column <= 15 And Target.Column >= 9 And Target.Row >= 7 And Target.Row <= 18 Then '選擇I7:O18才執行
  3.     Range(Cells(Target.Row, "i"), Cells(Target.Row, "o")).Select'把選擇的範圍Row再擴大為 I 到 O 選擇
  4. End If
  5. End Sub
複製代碼

作者: msmplay    時間: 2017-2-25 01:00

回復 2# lpk187


   l大~非常感謝您的熱心幫忙~~不過醬好像反而變得更多問題了耶!!噗~~~~
1. 雖然自動反色效果是要在I7:O18成立,但並不是要把整列選起來,因為醬會變成如果我需要在I7:O18裡其中一格複製或貼上的話,就會變成一整列複製、一整列貼上,而不能只單選一個儲存格了。
2. I7:O18無論點選任一儲存格都會變成選取整列,醬會造成我無法顯示目前選取的儲存格是停留在哪一格上面,因為整列反色是為了突顯該列,但仍需要正常顯示點選儲存格時的黑邊框喔。


所以如果可以,還是希望能以原有效果呈現,只是再修改一下條件,醬有辦法達到嗎?
作者: lpk187    時間: 2017-2-25 02:10

回復 3# msmplay


    嗯!可能是我理解能力太差!你2次的說明我都看不懂!肇成你的因擾,實感抱歉 !
作者: 准提部林    時間: 2017-2-25 10:50

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

格式化條件公式:=MODE(ROW(),ROW(colorcell)) 
 
[attach]26722[/attach]
 
 
作者: msmplay    時間: 2017-2-26 21:16

回復 5# 准提部林


   准大~~非常感謝幫忙喔!!
作者: momo020608    時間: 2017-2-26 21:38

請問
可同時選取2列以上的條件,可以變成用  ctrl 點選 多列以上嗎?
作者: 准提部林    時間: 2017-2-26 22:33

回復 7# momo020608

同時選取2列以上,可以變成用  ctrl 點選 多列以上嗎?

[attach]26728[/attach]

若列數太多, 不保證有效(文字串字數可能超限)
作者: momo020608    時間: 2017-2-27 07:47

回復 8# 准提部林

謝謝大師~
作者: Hyuan    時間: 2018-12-9 10:04

回復  momo020608

同時選取2列以上,可以變成用  ctrl 點選 多列以上嗎?



若列數太多, 不保證有 ...
准提部林 發表於 2017-2-26 22:33

想引用這個主題請教准大:
點選儲存格的行也須反色(目前只有列有反色),及列與行交集處(即點選的儲存格)用別的顏色反色(例如用紅色),要如何做到???
作者: 准提部林    時間: 2018-12-9 10:58

回復 10# Hyuan


舉幾個實例說明, 最好再上傳模擬檔案!!
作者: n7822123    時間: 2018-12-9 15:36

本帖最後由 n7822123 於 2018-12-9 15:46 編輯

回復 10# Hyuan

是這樣嗎? 紅色字部分請自行更改!
我沒有用到定義名稱的部分

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

[attach]29787[/attach]
作者: Hyuan    時間: 2018-12-9 19:23

回復 11# 准提部林

附上附件
請教准大要如何做到如附件的畫面。
謝謝你。
作者: Hyuan    時間: 2018-12-9 19:34

回復 11# 准提部林
表達不完整,原附件作廢。
作者: n7822123    時間: 2018-12-9 20:20

本帖最後由 n7822123 於 2018-12-9 20:23 編輯

回復 14# Hyuan

紅色字部分,可自行更改

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

[attach]29792[/attach]
作者: Hyuan    時間: 2018-12-9 20:21

回復 12# n7822123
謝謝大大鼎力幫忙。
希望儲存格所在的[行]也有顏色,如附件。
作者: n7822123    時間: 2018-12-9 20:24

回復 16# Hyuan


  已回覆你了,上上樓
作者: 准提部林    時間: 2018-12-10 13:33

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

湊一腳 參考看看
  1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  2.     Dim xA As Range, xR As Range
  3.     Set xA = [I7:O18]
  4.     xA.Interior.ColorIndex = 0
  5.     If Intersect(xA, Target) Is Nothing Then Exit Sub
  6.     For Each xR In xA.Columns
  7.         If Not Intersect(xR, Target) Is Nothing Then xR.Interior.Color = vbYellow
  8.     Next
  9.     For Each xR In xA.Rows
  10.         If Not Intersect(xR, Target) Is Nothing Then xR.Interior.Color = vbYellow
  11.     Next
  12.     Target.Interior.Color = vbRed
  13. End Sub
複製代碼

作者: Hyuan    時間: 2018-12-10 20:10

回復 19# GBKEE

很感謝n大、准大、G大三位鼎力相助。感謝~~~

也感謝有真麼好的討論園地。




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