Option Explicit
Sub 檢測_選取問題格()
Dim i&, Arr, n, xR As Range, C%, R&
Arr = ActiveSheet.UsedRange
For C = 1 To UBound(Arr, 2)
For R = 1 To UBound(Arr)
If InStr("/主/副/●/", "/" & Trim(Arr(R, C)) & "/") Then
n = n + 1
If n >= 7 Then
If Not xR Is Nothing Then
Set xR = Union(xR, Cells(R, C))
Else
Set xR = Cells(R, C)
End If
End If
Else
n = 0
End If
Next
n = 0
Next
If Not xR Is Nothing Then
Application.Goto xR
Else
MsgBox "沒有連續七天上班!"
End If
End Sub作者: jsc0518 時間: 2023-2-6 20:37
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
With Target
'↑以下是關於左鍵雙擊的程序
If .Count > 1 Then Exit Sub
'↑如果觸發的儲存格數大於1,就結束程式執行 (例如:觸發的是合併儲存格)
If InStr("/主/副/●//", "/" & Trim(.Value) & "/") Then
'↑如果觸發格值去除前後空白字元後,在前後連接 "/" 符號的新字串,包含在 "/主/副/●//"字串裡??
.Font.ColorIndex = 1
'↑令觸發格字色是 黑色
.Value = Switch(.Value = "", "●", .Value = "●", "", .Value = "主", "", .Value = "副", "")
'↑令觸發格值是以Switch 函式回傳的字串值
'https://learn.microsoft.com/zh-tw/office/vba/language/reference/user-interface-help/switch-function
'如果原儲存格值是 空字元,就回傳 "●"
'如果原儲存格值是 "●",就回傳 空字元
'如果原儲存格值是 "主",就回傳 空字元
'如果原儲存格值是 "副",就回傳 空字元
Cancel = True
'↑取消左鍵雙擊的原功能
End If
End With
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
With Target
'↑以下是關於右鍵單擊的程序
If .Count > 1 Then .Font.ColorIndex = 1: Call 檢測_選取問題格: Exit Sub
'↑如果觸發的儲存格數大於1,令觸發格字色是 黑色,執行 (檢測_選取問題格)副程式,結束程式執行
If InStr("/主/副/●//", "/" & Trim(.Value) & "/") Then
'↑如果觸發格值去除前後空白字元後,在前後連接 "/" 符號的新字串,包含在 "/主/副/●//"字串裡??
.Value = Switch(.Value = "", "主", .Value = "●", "主", .Value = "主", "副", .Value = "副", "主")
'↑令觸發格值是以Switch 函式回傳的字串值
'如果原儲存格值是 空字元,就回傳 "主"
'如果原儲存格值是 "●",就回傳 "主"
'如果原儲存格值是 "主",就回傳 "副"
'如果原儲存格值是 "副",就回傳 "主"
Cancel = True
'↑取消右鍵單擊的原功能
End If
End With
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
'↑以下是關於儲存格內容編輯觸發的程序
Call 檢測_選取問題格
'↑執行 (檢測_選取問題格)副程式
End With
End Sub
Option Explicit
Sub 檢測_選取問題格()
Dim Arr, xR As Range, C%, i&, R&, n&
'↑宣告變數! (Arr)是通用型變數,(xR)是儲存格變數,(C)是短整數變數,(i,R,n)是長整數變數
Arr = ActiveSheet.UsedRange
'↑令Arr這通用型變數是二維陣列,以現表有使用儲存格擴展最小方正範圍儲存格值倒入
For C = 1 To UBound(Arr, 2)
'↑設順迴圈!C從1到Arr陣列橫向最大索引欄號數
For R = 1 To UBound(Arr)
'↑設順迴圈!R從1到Arr陣列縱向最大索引列號數
If InStr("/主/副/●/", "/" & Trim(Arr(R, C)) & "/") Then
'↑如果迴圈Arr陣列值去除前後空白字元後,在前後連接 "/" 符號的新字串,包含在 ""/主/副/●/""字串裡??
If Cells(R, C).Font.ColorIndex <> 1 Then Cells(R, C).Font.ColorIndex = 1
'↑如果迴圈儲存格字色不是黑色!就變為 黑色
n = n + 1
'↑令n這長整數變數累加 1
If n >= 7 Then
'↑如果n變數 > 7 ??
If Not xR Is Nothing Then
'↑如果xR這儲存格變數已有物件
Set xR = Union(xR, Cells(R, C))
'↑令xR變數將 迴圈儲存格納入在 xR變數後面,成為新的儲存格集
Else
Set xR = Cells(R, C)
'↑否則令xR 是迴圈儲存格
End If
End If
Else
n = 0
'↑令n變數歸零
End If
Next
n = 0
'↑令n變數歸零(因為跨欄不再累加上班天數)
Next
If Not xR Is Nothing Then
'↑如果xR這儲存格變數已有物件
Application.Goto xR
'↑選取xR變數儲存格
xR.Font.ColorIndex = 3
'↑令xR變數儲存格字色是 紅色
MsgBox "**** 連續七天上班! ****"
'↑跳出提示窗
End If
End Sub作者: jsc0518 時間: 2023-2-10 21:51
