通勤認定エクセルツール対応12 Z4からO3に変更

This commit is contained in:
guanxiangwei
2026-05-27 10:50:49 +09:00
parent 85707853e6
commit ca2ae646fb
7 changed files with 71 additions and 120 deletions

View File

@@ -48,8 +48,8 @@ Sub RefreshCache_Button()
Dim exitMsg As String
Dim activeSheetName As String: activeSheetName = ActiveSheet.CodeName
Debug.Print "1. Validate Z1~Z4, T1~T3, O1~O2 master data"
Dim cacheSheets As Variant: cacheSheets = Array("Z1", "Z2", "Z3", "Z4", "T1", "T2", "T3", "O1", "O2")
Debug.Print "1. Validate Z1~Z4, T1~T3, O1~O3 master data"
Dim cacheSheets As Variant: cacheSheets = Array("Z1", "Z2", "Z3", "T1", "T2", "T3", "O1", "O2", CACHE_O3)
Dim sheetName As Variant
Dim ws As Worksheet
For Each sheetName In cacheSheets

View File

@@ -8,6 +8,9 @@ Option Explicit
' - RefreshM2Cache
' - RefreshO1Cache
' ============================================================
Public Const CACHE_O3 As String = CACHE_O3
Private sheetConfDict As Object
Private FormulaCache As Object
Public GlobalCache As Object
@@ -381,24 +384,6 @@ Private Sub RefreshSheetDict()
Set sheetConfDict("Z3") = sheetConf
Debug.Print "RefreshSheetDict Z3 ok."
' Z4
Set sheetConf = CreateObject("Scripting.Dictionary")
sheetConf("StartCol") = "C"
sheetConf("EndCol") = "I"
sheetConf("ErrorCol") = "B"
sheetConf("StartRow") = 7
sheetConf("HeaderRow") = 5
sheetConf("CSV_Encoding") = "utf-8"
sheetConf("HasHeader") = False
sheetConf("ExpectedColumnCount") = 7
sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I")
sheetConf("AlwaysQuote") = True
sheetConf("FilterRow") = 6
sheetConf("KeyCol") = 3
sheetConf("ValueCols") = Array(4)
Set sheetConfDict("Z4") = sheetConf
Debug.Print "RefreshSheetDict Z4 ok."
' T1
Set sheetConf = CreateObject("Scripting.Dictionary")
sheetConf("StartCol") = "C"
@@ -487,6 +472,24 @@ Private Sub RefreshSheetDict()
Set sheetConfDict("O2") = sheetConf
Debug.Print "RefreshSheetDict O2 ok."
' O3
Set sheetConf = CreateObject("Scripting.Dictionary")
sheetConf("StartCol") = "C"
sheetConf("EndCol") = "I"
sheetConf("ErrorCol") = "B"
sheetConf("StartRow") = 6
sheetConf("HeaderRow") = 5
sheetConf("CSV_Encoding") = "utf-8"
sheetConf("HasHeader") = False
sheetConf("ExpectedColumnCount") = 7
sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I")
sheetConf("AlwaysQuote") = True
sheetConf("FilterRow") = 5
sheetConf("KeyCol") = 3
sheetConf("ValueCols") = Array(4)
Set sheetConfDict(CACHE_O3) = sheetConf
Debug.Print "RefreshSheetDict O3 ok."
' Enum
Set sheetConf = Nothing
sheetConfDict("Enum") = Array("tokubetuList", "kenshuList", "renrakuList", "oufukuList", "koutaiList", "higaitouList", "errorList")
@@ -565,7 +568,7 @@ End Function
Public Sub RefreshMasterCache()
' Fixed cache names
Dim fixedCaches As Variant
fixedCaches = Array("Z1", "Z2", "Z3", "Z4", "T1", "T2", "T3", "O1", "O2", _
fixedCaches = Array("Z1", "Z2", "Z3", "T1", "T2", "T3", "O1", "O2", CACHE_O3, _
"tokubetuList", "kenshuList", "renrakuList", "oufukuList", "koutaiList", "higaitouList", "errorList")
' Refresh fixed caches
@@ -604,7 +607,7 @@ Public Sub WriteCachesSheet(ByVal cacheName As String)
Case "Z1": colLetter = "A"
Case "Z2": colLetter = "B"
Case "Z3": colLetter = "C"
Case "Z4": colLetter = "D"
Case CACHE_O3: colLetter = "D"
Case "T1": colLetter = "E"
Case "T2": colLetter = "F"
Case "T3": colLetter = "G"

View File

@@ -38,13 +38,13 @@ End Function
' Create Todoke (G) dropdown
Public Function BuildTodokeList()
Dim z4Cache As Object: Set z4Cache = GetCache("Z4")
Dim o3Cache As Object: Set o3Cache = GetCache(CACHE_O3)
Dim dropdownList As String
Dim key As Variant
For Each key In z4Cache.Keys
For Each key In o3Cache.Keys
Dim displayText As String
displayText = MakeSelect(key, z4Cache(key)(0))
displayText = MakeSelect(key, o3Cache(key)(0))
If dropdownList = "" Then
dropdownList = displayText
Else

View File

@@ -135,11 +135,11 @@ Private Sub Worksheet_Change(ByVal Target As Range)
For Each cellG In Target
Dim todoke As String: todoke = Trim(cellG.Value)
If todoke <> "" Then
Dim z4Cache As Object: Set z4Cache = GetCache("Z4")
Dim o3Cache As Object: Set o3Cache = GetCache(CACHE_O3)
Dim todokeCde As String: todokeCde = GetCode(todoke)
If z4Cache.Exists(todokeCde) Then
If o3Cache.Exists(todokeCde) Then
Dim cellH As Range: Set cellH = Me.Cells(cellG.Row, 8)
cellH.Value = z4Cache(todokeCde)(0)
cellH.Value = o3Cache(todokeCde)(0)
End If
End If
Next
@@ -816,9 +816,9 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
' validate CodeSelect
' G column [todoke Cde]
Dim ColG As String: ColG = "G"
Dim z4Cache As Object: Set z4Cache = GetCache("Z4")
Dim o3Cache As Object: Set o3Cache = GetCache(CACHE_O3)
Dim todokeCde As String: todokeCde = GetCode(Trim(Me.Cells(rowNum, ColG).Value))
If Not z4Cache.Exists(todokeCde) Then
If Not o3Cache.Exists(todokeCde) Then
Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E001", ColG & rowNum)
Me.Range(ColG & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub

38
src/sh/tuk/sheet/O3.cls Normal file
View File

@@ -0,0 +1,38 @@
' ============================================================
' Module Name: Master_Z4_220
' Module Desc: Z4 master data management (220)
' Module Methods:
' - Worksheet_Change
' - Validate
' ============================================================
' ============================================================
' Event Handlers
' ============================================================
Private Sub Worksheet_Change(ByVal Target As Range)
Dim HasHeaderEdit As Boolean: HasHeaderEdit = CheckHeaderEdit(Me, Target)
If HasHeaderEdit = True Then Exit Sub
End Sub
' Prevent insert/delete row in header area
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(Me.CodeName)
Dim filterRow As Long: filterRow = sheetConf("FilterRow")
If Target.Row < filterRow + 1 Then
Cancel = True
MsgBox "Cannot insert or delete row in header area.", vbExclamation
End If
End Sub
'
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
On Error GoTo ErrHandler
Exit Sub
ErrHandler:
lastErrorMsg = Err.Description
End Sub

View File

@@ -1,90 +0,0 @@
' ============================================================
' Module Name: Master_Z4_220
' Module Desc: Z4 master data management (220)
' Module Methods:
' - Worksheet_Change
' - Validate
' ============================================================
' ============================================================
' Event Handlers
' ============================================================
Private Sub Worksheet_Change(ByVal Target As Range)
Dim HasHeaderEdit As Boolean: HasHeaderEdit = CheckHeaderEdit(Me, Target)
If HasHeaderEdit = True Then Exit Sub
End Sub
' Prevent insert/delete row in header area
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(Me.CodeName)
Dim filterRow As Long: filterRow = sheetConf("FilterRow")
If Target.Row < filterRow + 1 Then
Cancel = True
MsgBox "Cannot insert or delete row in header area.", vbExclamation
End If
End Sub
'
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
On Error GoTo ErrHandler
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
Dim startCol As String: startCol = sheetConf("StartCol")
Dim endCol As String: endCol = sheetConf("EndCol")
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
' clear C~I columns background color
Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
clearRange.Interior.Color = vbWhite
' C column check
checkResult = CheckRequired(ws, rowNum, 3, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckChar(ws, rowNum, 3, 2, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckAlphanumeric(ws, rowNum, 3, 2, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckDuplicate(ws, rowNum, 3, errorCol)
If checkResult = False Then Exit Sub
' D column check
checkResult = CheckRequired(ws, rowNum, 4, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckVarcharOver(ws, rowNum, 4, 80, errorCol)
If checkResult = False Then Exit Sub
' E column check
checkResult = CheckVarcharOver(ws, rowNum, 5, 80, errorCol)
If checkResult = False Then Exit Sub
' F column check
checkResult = CheckVarcharOver(ws, rowNum, 6, 80, errorCol)
If checkResult = False Then Exit Sub
' G column check
checkResult = Check01(ws, rowNum, 7, errorCol)
If checkResult = False Then Exit Sub
' H column check
checkResult = CheckVarcharOver(ws, rowNum, 8, 80, errorCol)
If checkResult = False Then Exit Sub
' I column check
checkResult = Check12(ws, rowNum, 9, errorCol)
If checkResult = False Then Exit Sub
ws.Cells(rowNum, errorCol).ClearContents
Exit Sub
ErrHandler:
lastErrorMsg = Err.Description
End Sub