- 帖子
- 1447
- 主題
- 40
- 精華
- 0
- 積分
- 1471
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-12-5
|
2#
發表於 2024-1-15 09:06
| 只看該作者
本帖最後由 Andy2483 於 2024-1-15 10:11 編輯
回復 1# wayne0303
謝謝前輩發表此主題
程序執行可以用,可以正確執行最重要,如果能明確指出問題癥結或上傳範例,比較容易理解需求
前輩提供範例理解如下:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'↑儲存格內容改變的觸發事件
Dim xA As Range, xR As Range
'↑宣告變數
Application.ScreenUpdating = False
'↑螢幕暫不隨程序改變結果
Set xA = Intersect(Target, Range("U:U"))
'↑令xA變數是觸發格與U欄的交集儲存格
If xA Is Nothing Then GoTo xA0
'↑如果xA變數沒交集到任何儲存格!就跳到標示xA0位置繼續執行
For Each xR In xA
'↑設逐項迴圈!令xR變數是xA這交集格的一格
Range(Cells(xR.Row, 1), Cells(xR.Row, 22)).Font.ColorIndex = 15 ^ -(xR > 1)
'↑令儲存格文字顏色是灰色或黑色
'儲存格:xR當列A欄到V欄之間的連續儲存格
Next
xA0:
Set xA = Intersect(Target, Range("O:O"))
'↑令xA變數是觸發格與O欄的交集儲存格
If xA Is Nothing Then GoTo xA1
'↑如果xA變數沒交集到任何儲存格!就跳到標示xA1位置繼續執行
For Each xR In xA
'↑設逐項迴圈!令xR變數是xA這交集格的一格
Range(Cells(xR.Row, 16), xR).Font.ColorIndex = 2 ^ -(xR = "")
'↑令儲存格文字顏色是白色或黑色
'儲存格:xR當列O欄到P欄之間的連續儲存格
Next
xA1:
Set xA = Intersect(Target, Range("J:J"))
'↑令xA變數是觸發格與J欄的交集儲存格
If xA Is Nothing Then GoTo xA2
'↑如果xA變數沒交集到任何儲存格!就跳到標示xA2位置繼續執行
For Each xR In xA
'↑設逐項迴圈!令xR變數是xA這交集格的一格
Range(Cells(xR.Row, 10), xR).Font.Color = RGB(0, 176, 240) ^ -(xR = "L")
Range(Cells(xR.Row, 10), xR).Font.Bold = (xR = "L")
'↑令儲存格文字顏色是淺藍色或黑色,令儲存格文字是粗體或非粗體
'儲存格:xR當列J欄儲存格
Next
xA2:
Set xA = Intersect(Target, Range("v:v"))
'↑令xA變數是觸發格與V欄的交集儲存格
If xA Is Nothing Then GoTo xA3
'↑如果xA變數沒交集到任何儲存格!就跳到標示xA3位置繼續執行
For Each xR In xA
'↑設逐項迴圈!令xR變數是xA這交集格的一格
Range(Cells(xR.Row, 1), xR).Font.Color = RGB(153, 102, 0) ^ -((xR Like "*拆圖"))
'↑令儲存格文字顏色是土色或黑色
'儲存格:xR當列A欄到V欄之間的連續儲存格
Next
xA3:
Set xA = Intersect(Target, Range("p:p"))
'↑令xA變數是觸發格與P欄的交集儲存格
If xA Is Nothing Then GoTo xA4
'↑如果xA變數沒交集到任何儲存格!就跳到標示xA4位置繼續執行
For Each xR In xA
'↑設逐項迴圈!令xR變數是xA這交集格的一格
Range(Cells(xR.Row, 1), Cells(xR.Row, 22)).Font.ColorIndex = 5 ^ -(xR.Font.Strikethrough = True)
'↑令儲存格文字顏色是藍色或黑色
'儲存格:xR當列A欄到V欄之間的連續儲存格
Next
xA4:
Set xA = Intersect(Target, Range("E:E"))
'↑令xA變數是觸發格與E欄的交集儲存格
If xA Is Nothing Then Exit Sub
'↑如果xA變數沒交集到任何儲存格!就結束程式執行
Dim st As String
Dim cell As Range
'↑宣告變數
For Each cell In Me.Range("E2:E" & Me.Cells(Me.Rows.Count, "E").End(3).Row)
'↑設逐項迴圈!令cell變數是本表E欄裡的儲存格
st = IIf(cell.Value = "", "", _
IIf(cell.Offset(0, -1).Value > 0, "LOB", _
IIf(Application.WorksheetFunction.CountIf(cell, "S1A*") > 0, "TM", "MU")))
'↑令st變數是IIf()回傳值
cell.Offset(0, -3).Value = st
'↑令cell變數左3格儲存格值是st變數
Next
End Sub |
|
