通勤認定エクセルツール対応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 exitMsg As String
Dim activeSheetName As String: activeSheetName = ActiveSheet.CodeName Dim activeSheetName As String: activeSheetName = ActiveSheet.CodeName
Debug.Print "1. Validate Z1~Z4, T1~T3, O1~O2 master data" Debug.Print "1. Validate Z1~Z4, T1~T3, O1~O3 master data"
Dim cacheSheets As Variant: cacheSheets = Array("Z1", "Z2", "Z3", "Z4", "T1", "T2", "T3", "O1", "O2") Dim cacheSheets As Variant: cacheSheets = Array("Z1", "Z2", "Z3", "T1", "T2", "T3", "O1", "O2", CACHE_O3)
Dim sheetName As Variant Dim sheetName As Variant
Dim ws As Worksheet Dim ws As Worksheet
For Each sheetName In cacheSheets For Each sheetName In cacheSheets

View File

@@ -8,6 +8,9 @@ Option Explicit
' - RefreshM2Cache ' - RefreshM2Cache
' - RefreshO1Cache ' - RefreshO1Cache
' ============================================================ ' ============================================================
Public Const CACHE_O3 As String = CACHE_O3
Private sheetConfDict As Object Private sheetConfDict As Object
Private FormulaCache As Object Private FormulaCache As Object
Public GlobalCache As Object Public GlobalCache As Object
@@ -381,24 +384,6 @@ Private Sub RefreshSheetDict()
Set sheetConfDict("Z3") = sheetConf Set sheetConfDict("Z3") = sheetConf
Debug.Print "RefreshSheetDict Z3 ok." 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 ' T1
Set sheetConf = CreateObject("Scripting.Dictionary") Set sheetConf = CreateObject("Scripting.Dictionary")
sheetConf("StartCol") = "C" sheetConf("StartCol") = "C"
@@ -487,6 +472,24 @@ Private Sub RefreshSheetDict()
Set sheetConfDict("O2") = sheetConf Set sheetConfDict("O2") = sheetConf
Debug.Print "RefreshSheetDict O2 ok." 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 ' Enum
Set sheetConf = Nothing Set sheetConf = Nothing
sheetConfDict("Enum") = Array("tokubetuList", "kenshuList", "renrakuList", "oufukuList", "koutaiList", "higaitouList", "errorList") sheetConfDict("Enum") = Array("tokubetuList", "kenshuList", "renrakuList", "oufukuList", "koutaiList", "higaitouList", "errorList")
@@ -565,7 +568,7 @@ End Function
Public Sub RefreshMasterCache() Public Sub RefreshMasterCache()
' Fixed cache names ' Fixed cache names
Dim fixedCaches As Variant 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") "tokubetuList", "kenshuList", "renrakuList", "oufukuList", "koutaiList", "higaitouList", "errorList")
' Refresh fixed caches ' Refresh fixed caches
@@ -604,7 +607,7 @@ Public Sub WriteCachesSheet(ByVal cacheName As String)
Case "Z1": colLetter = "A" Case "Z1": colLetter = "A"
Case "Z2": colLetter = "B" Case "Z2": colLetter = "B"
Case "Z3": colLetter = "C" Case "Z3": colLetter = "C"
Case "Z4": colLetter = "D" Case CACHE_O3: colLetter = "D"
Case "T1": colLetter = "E" Case "T1": colLetter = "E"
Case "T2": colLetter = "F" Case "T2": colLetter = "F"
Case "T3": colLetter = "G" Case "T3": colLetter = "G"

View File

@@ -38,13 +38,13 @@ End Function
' Create Todoke (G) dropdown ' Create Todoke (G) dropdown
Public Function BuildTodokeList() 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 dropdownList As String
Dim key As Variant Dim key As Variant
For Each key In z4Cache.Keys For Each key In o3Cache.Keys
Dim displayText As String Dim displayText As String
displayText = MakeSelect(key, z4Cache(key)(0)) displayText = MakeSelect(key, o3Cache(key)(0))
If dropdownList = "" Then If dropdownList = "" Then
dropdownList = displayText dropdownList = displayText
Else Else

View File

@@ -135,11 +135,11 @@ Private Sub Worksheet_Change(ByVal Target As Range)
For Each cellG In Target For Each cellG In Target
Dim todoke As String: todoke = Trim(cellG.Value) Dim todoke As String: todoke = Trim(cellG.Value)
If todoke <> "" Then 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) 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) 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
End If End If
Next Next
@@ -816,9 +816,9 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
' validate CodeSelect ' validate CodeSelect
' G column [todoke Cde] ' G column [todoke Cde]
Dim ColG As String: ColG = "G" 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)) 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.Cells(rowNum, errorCol).Value = GetErrorMsg("E001", ColG & rowNum)
Me.Range(ColG & rowNum).Interior.Color = RGB(255, 0, 0) Me.Range(ColG & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub 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