VBA點選儲存格指定範圍自動反色 - Excel程式區

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

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

11^# 跳轉到 »

發表於 2018-12-9 10:58 | 只看該作者

回復 10# Hyuan

舉幾個實例說明, 最好再上傳模擬檔案!!

TOP

n7822123

　暱稱: 阿龍

中學生 Rank: 2

帖子: 406
主題: 8
精華: 0
積分: 453
點名: 0
作業系統: WINDOWS 7
軟體版本: 2007
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2015-2-7
最後登錄: 2021-7-31

12^#

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

儲存格變色.rar (11.11 KB)

程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP

Hyuan

中學生 Rank: 2

帖子: 12
主題: 2
精華: 0
積分: 64
點名: 0
作業系統: WIN10
軟體版本: office 2016
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2018-3-8
最後登錄: 2019-11-25

13^#

發表於 2018-12-9 19:23 | 只看該作者

回復 11# 准提部林

附上附件
請教准大要如何做到如附件的畫面。
謝謝你。

TT20170225-02(選取儲存格,列變色).zip (9.94 KB)

TOP

Hyuan

中學生 Rank: 2

帖子: 12
主題: 2
精華: 0
積分: 64
點名: 0
作業系統: WIN10
軟體版本: office 2016
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2018-3-8
最後登錄: 2019-11-25

14^#

發表於 2018-12-9 19:34 | 只看該作者

回復 11# 准提部林
表達不完整，原附件作廢。

TT20170225-02(選取儲存格,列變色).zip (9.95 KB)

TOP

n7822123

　暱稱: 阿龍

中學生 Rank: 2

帖子: 406
主題: 8
精華: 0
積分: 453
點名: 0
作業系統: WINDOWS 7
軟體版本: 2007
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2015-2-7
最後登錄: 2021-7-31

15^#

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

TT20170225-02(選取儲存格,列變色)+1.rar (9.18 KB)

程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP

Hyuan

中學生 Rank: 2

帖子: 12
主題: 2
精華: 0
積分: 64
點名: 0
作業系統: WIN10
軟體版本: office 2016
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2018-3-8
最後登錄: 2019-11-25

16^#

發表於 2018-12-9 20:21 | 只看該作者

回復 12# n7822123
謝謝大大鼎力幫忙。
希望儲存格所在的[行]也有顏色，如附件。

儲存格變色.zip (7.66 KB)

TOP

n7822123

　暱稱: 阿龍

中學生 Rank: 2

帖子: 406
主題: 8
精華: 0
積分: 453
點名: 0
作業系統: WINDOWS 7
軟體版本: 2007
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2015-2-7
最後登錄: 2021-7-31

17^#

發表於 2018-12-9 20:24 | 只看該作者

回復 16# Hyuan

已回覆你了，上上樓

程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

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

18^#

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

TOP

GBKEE