K_Wing

帖子: 140
主題: 27
精華: 0
積分: 158
點名: 0
作業系統: Windows10
軟體版本: office 2013
閱讀權限: 20
性別: 男
註冊時間: 2014-11-27
最後登錄: 2023-2-26

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2015-10-29 14:57 | 只看該作者

[發問] 游標進入某個儲存格,如何可令相關區域顯示色彩

未知Excel可否使用以下方法顯示組合數
如附件中
H11=SUM(C5+B5)
我可否用游標移入H11儲存格後
C5和B5這兩個儲存格會顯示顏色(字色或者底色)
又或者這三個儲存格都顯示顏色

樓主熱帖

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

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

2^#

發表於 2015-10-29 21:20 | 只看該作者

本帖最後由准提部林於 2015-10-31 09:35 編輯

提供以下方案，參考看看（此方式不影響復原功能）

測試檔下載:

20151031-01(公式參照格填色).rar (8.48 KB)

＜工作表事件區＞　
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Target
　　　On Error Resume Next
　　　Set xArea = Nothing
　　　If .Count > 1 Then Exit Sub
　　　Application.EnableEvents = False
　　　Set xArea = .DirectPrecedents
　　　If Not xArea Is Nothing Then Set xArea = Union(.Cells, xArea)
End With
Application.EnableEvents = True
[IV1].Calculate
End Sub
　
　
＜一般模組區＞　　
Public xArea As Range
　
Function XXX(xA As Range) As Long
If Not Intersect(xArea, xA) Is Nothing Then XXX = 1
End Function
　
　
＜儲存格．格式化條件＞　
Ｂ５：=xxx(B5)　設黃底色或自訂

公式格，及被參照格都要照此設定

TOP

K_Wing

中學生 Rank: 2

帖子: 140
主題: 27
精華: 0
積分: 158
點名: 0
作業系統: Windows10
軟體版本: office 2013
閱讀權限: 20
性別: 男
註冊時間: 2014-11-27
最後登錄: 2023-2-26

3^#

發表於 2015-10-31 08:03 | 只看該作者

提供以下方案，參考看看（此方式不影響復原功能）

＜工作表事件區＞　
Private Sub Worksheet_Selectio ...
准提部林發表於 2015-10-29 21:20

感謝指導
可惜此方法在我來說
不懂得如何設置
謝謝你

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

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

4^#

發表於 2015-10-31 09:37 | 只看該作者

回復 3# K_Wing

已補上測試檔, 試看看吧!
_複雜公式就不太適用
_因事件觸發程式, 可能會有預期不到的狀況

TOP

K_Wing

中學生 Rank: 2

帖子: 140
主題: 27
精華: 0
積分: 158
點名: 0
作業系統: Windows10
軟體版本: office 2013
閱讀權限: 20
性別: 男
註冊時間: 2014-11-27
最後登錄: 2023-2-26

5^#

發表於 2015-10-31 11:04 | 只看該作者

回復 K_Wing

已補上測試檔, 試看看吧!
_複雜公式就不太適用
_因事件觸發程式, 可能會有預期不到的狀 ...
准提部林發表於 2015-10-31 09:37

公司的電腦解不開rar
讓我放工回家後再試試
謝謝幫忙

TOP

K_Wing

中學生 Rank: 2

帖子: 140
主題: 27
精華: 0
積分: 158
點名: 0
作業系統: Windows10
軟體版本: office 2013
閱讀權限: 20
性別: 男
註冊時間: 2014-11-27
最後登錄: 2023-2-26

6^#

發表於 2015-11-1 11:27 | 只看該作者

回復 4# 准提部林

這個測試檔很簡單
但未能滿足上司的要求
暫時使用以下方法

TOP

yen956

高中生 Rank: 3 Rank: 3

帖子: 522
主題: 36
精華: 1
積分: 603
點名: 0
作業系統: win xp sp3
軟體版本: Office 2003
閱讀權限: 50
性別: 男
註冊時間: 2012-12-13
最後登錄: 2021-7-11

7^#

發表於 2015-11-1 16:00 | 只看該作者

試試看:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Rng As Range
Dim col1, row1 As Integer
col1 = Target.Column
row1 = Target.Row Mod 5
Set Rng = Union([H4:K5], [H9:K10], [H14:K15], [H19:K20]) '設定 Worksheet_SelectionChange 觸動區域
[B4:K20].Interior.ColorIndex = xlNone
If Not Intersect(Target, Rng) Is Nothing Then
Target.Interior.ColorIndex = 7
If row1 = 4 Then
Select Case col1
Case Is = 8: Target.Offset(1, -6).Resize(1, 2).Interior.ColorIndex = 7
Case Is = 9: Target.Offset(0, -7).Resize(1, 2).Interior.ColorIndex = 7
Case Is = 10: Target.Offset(0, -8).Resize(2, 1).Interior.ColorIndex = 7
Case Is = 11: Target.Offset(0, -8).Resize(2, 1).Interior.ColorIndex = 7
End Select
Else
Select Case col1
Case Is = 8: Target.Offset(0, -4).Resize(1, 2).Interior.ColorIndex = 7
Case Is = 9: Target.Offset(-1, -5).Resize(1, 2).Interior.ColorIndex = 7
Case Is = 10: Target.Offset(-1, -6).Resize(2, 1).Interior.ColorIndex = 7
Case Is = 11: Target.Offset(-1, -6).Resize(2, 1).Interior.ColorIndex = 7
End Select
End If
End If
End Sub