帖子: 218
主題: 73
精華: 0
積分: 290
點名: 0
作業系統: WIN10
軟體版本: Office2010
閱讀權限: 20
性別: 女
註冊時間: 2014-5-19
最後登錄: 2022-11-29

1^# 跳轉到 » 倒序看帖

字體大小: tT

發表於 2017-2-24 22:28 | 只看該作者

[發問] VBA點選儲存格指定範圍自動反色

以下程式碼是在網路上找到的，但想請教該如何修改成以下想要的條件呢？
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

測試檔.rar (15.08 KB)

樓主熱帖

*宅女一枚無誤*

lpk187

高中生 Rank: 3 Rank: 3

帖子: 552
主題: 3
精華: 0
積分: 578
點名: 0
作業系統: win7
軟體版本: office 2010
閱讀權限: 50
性別: 男
註冊時間: 2015-2-8
最後登錄: 2024-7-9

2016猴年全勤獎章 2015羊年全勤獎章熱烈參與勳章

2^#

發表於 2017-2-25 00:12 | 只看該作者

回復 1# msmplay

看起來好像複雜化了，若只有點選反白只要如下代碼即可

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column <= 15 And Target.Column >= 9 And Target.Row >= 7 And Target.Row <= 18 Then '選擇I7:O18才執行
Range(Cells(Target.Row, "i"), Cells(Target.Row, "o")).Select'把選擇的範圍Row再擴大為 I 到 O 選擇
End If
End Sub

複製代碼

TOP

msmplay

中學生 Rank: 2

帖子: 218
主題: 73
精華: 0
積分: 290
點名: 0
作業系統: WIN10
軟體版本: Office2010
閱讀權限: 20
性別: 女
註冊時間: 2014-5-19
最後登錄: 2022-11-29

3^#

發表於 2017-2-25 01:00 | 只看該作者

回復 2# lpk187

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

所以如果可以，還是希望能以原有效果呈現，只是再修改一下條件，醬有辦法達到嗎？

*宅女一枚無誤*

TOP

lpk187

高中生 Rank: 3 Rank: 3

帖子: 552
主題: 3
精華: 0
積分: 578
點名: 0
作業系統: win7
軟體版本: office 2010
閱讀權限: 50
性別: 男
註冊時間: 2015-2-8
最後登錄: 2024-7-9

2016猴年全勤獎章 2015羊年全勤獎章熱烈參與勳章

4^#

發表於 2017-2-25 02:10 | 只看該作者

回復 3# msmplay

嗯！可能是我理解能力太差！你2次的說明我都看不懂！肇成你的因擾，實感抱歉！

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2843
主題: 10
精華: 0
積分: 2899
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2025-10-18

5^#

發表於 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))　
　

Xl0000045.rar (10.37 KB)
　
　

TOP

msmplay