diff --git a/src/module/Generic_Master_Common.bas b/src/module/Generic_Master_Common.bas index 97142ba..e34b1e5 100644 --- a/src/module/Generic_Master_Common.bas +++ b/src/module/Generic_Master_Common.bas @@ -29,9 +29,8 @@ Sub Generic_Master_Import(ByVal ws As Worksheet, ByVal expectedColumnCount As Lo Dim colOffset As Long For colOffset = 1 To expectedColumnCount ws.Cells(writeRow, 2 + colOffset).Value = CleanCSVField(CStr(lines(i, colOffset))) - - writeRow = writeRow + 1 Next colOffset + writeRow = writeRow + 1 End If Next i diff --git a/src/module/Global_Cache.bas b/src/module/Global_Cache.bas index 38138e7..1e4d85c 100644 --- a/src/module/Global_Cache.bas +++ b/src/module/Global_Cache.bas @@ -18,9 +18,14 @@ Public m1KukanDCache As Object Public z1Cache As Object Public z2Cache As Object Public z3Cache As Object +Public z4Cache As Object Public o1Cache As Object Public o2Cache As Object Public m2Cache As Object +Public tokubetuList As Object +Public oufukuList As Object +Public koutaiList As Object +Public higaitouList As Object ' m1Cache - used by M2_Kukan_detail, Tukin_C1 ' m1KukanDCache - nested dict {D: {F: [G]}} @@ -229,6 +234,28 @@ Public Sub ClearZ3Cache() Set z3Cache = Nothing End Sub +' ============================================================ +' z4Cache +' ============================================================ +Public Sub RefreshZ4Cache() + On Error GoTo RefreshError + Set z4Cache = LoadLookup("Z4", keyCol:=3, valueCols:=Array(4), startRow:=7) + On Error GoTo 0 + + If z4Cache Is Nothing Or z4Cache.Count = 0 Then + Err.Raise 1003, "RefreshZ4Cache", "Enum reference data is empty" + End If + + Exit Sub + +RefreshError: + Err.Raise 1001, "RefreshZ4Cache", "Failed to load Enum lookup cache: " & Err.Description +End Sub + +Public Sub ClearZ4Cache() + Set z4Cache = Nothing +End Sub + ' ============================================================ ' O1 Cache ' ============================================================ @@ -312,8 +339,6 @@ End Sub ' ============================================================ ' tokubetuList ' ============================================================ -Public tokubetuList As Object - Public Sub GetTokubetu() On Error GoTo RefreshError Set tokubetuList = LoadLookup("Enum", keyCol:=1, valueCols:=Array(1), startRow:=3) @@ -333,38 +358,12 @@ Public Sub ClearTokubetu() Set tokubetuList = Nothing End Sub -' ============================================================ -' todokeList -' ============================================================ -Public todokeList As Object - -Public Sub GetTodokeList() - On Error GoTo RefreshError - Set todokeList = LoadLookup("Enum", keyCol:=6, valueCols:=Array(7), startRow:=3) - On Error GoTo 0 - - If todokeList Is Nothing Or todokeList.Count = 0 Then - Err.Raise 1003, "GetTodokeList", "Enum reference data is empty" - End If - - Exit Sub - -RefreshError: - Err.Raise 1001, "GetTodokeList", "Failed to load Enum lookup cache: " & Err.Description -End Sub - -Public Sub ClearTodokeList() - Set todokeList = Nothing -End Sub - ' ============================================================ ' oufukuList ' ============================================================ -Public oufukuList As Object - Public Sub GetOufukuList() On Error GoTo RefreshError - Set oufukuList = LoadLookup("Enum", keyCol:=9, valueCols:=Array(10), startRow:=3) + Set oufukuList = LoadLookup("Enum", keyCol:=6, valueCols:=Array(7), startRow:=3) On Error GoTo 0 If oufukuList Is Nothing Or oufukuList.Count = 0 Then @@ -384,11 +383,9 @@ End Sub ' ============================================================ ' koutaiList ' ============================================================ -Public koutaiList As Object - Public Sub GetKoutaiList() On Error GoTo RefreshError - Set koutaiList = LoadLookup("Enum", keyCol:=12, valueCols:=Array(13), startRow:=3) + Set koutaiList = LoadLookup("Enum", keyCol:=9, valueCols:=Array(10), startRow:=3) On Error GoTo 0 If koutaiList Is Nothing Or koutaiList.Count = 0 Then @@ -403,4 +400,26 @@ End Sub Public Sub ClearKoutaiList() Set koutaiList = Nothing +End Sub + +' ============================================================ +' higaitouList +' ============================================================ +Public Sub GetHigaitouList() + On Error GoTo RefreshError + Set higaitouList = LoadLookup("Enum", keyCol:=12, valueCols:=Array(13), startRow:=3) + On Error GoTo 0 + + If higaitouList Is Nothing Or higaitouList.Count = 0 Then + Err.Raise 1003, "GetHigaitouList", "Enum reference data is empty" + End If + + Exit Sub + +RefreshError: + Err.Raise 1001, "GetHigaitouList", "Failed to load Enum lookup cache: " & Err.Description +End Sub + +Public Sub ClearHigaitouList() + Set higaitouList = Nothing End Sub \ No newline at end of file diff --git a/src/thisWorkbook/Master_Z4_220.bas b/src/thisWorkbook/Master_Z4_220.bas new file mode 100644 index 0000000..094f621 --- /dev/null +++ b/src/thisWorkbook/Master_Z4_220.bas @@ -0,0 +1,173 @@ +' ============================================================ +' Module Name: Master_Z4_220 +' Module Desc: Z4 master data management (220) +' Module Methods: +' - Z4_Import +' - Z4_Export +' - Z4_SortDataRowsByC +' - Z4_ToggleAutoFilter +' ============================================================ +' ====== (220) ======= + +' ====== Constants ====== +Const START_COL As Long = 3 +Const END_COL As Long = 9 +Const ERROR_COL As Long = 2 + +' ====== Function ====== +Sub Z4_Import() + Call Generic_Master_Import(Me, 7) +End Sub + +Sub Z4_Export() + Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(Me, START_COL, END_COL) + + If lastDataRow < 7 Then + MsgBox "No data rows to output.", vbExclamation + Exit Sub + End If + + Dim r As Long, errorCount As Long + For r = 7 To lastDataRow + Validate r + If Trim(Cells(r, 2).Value & "") <> "" Then + errorCount = errorCount + 1 + End If + Next r + + If errorCount > 0 Then + MsgBox "Validation failed. Found " & errorCount & " error(s). Please correct them before exporting.", vbCritical + Exit Sub + End If + + Call Generic_Master_Export(Me, 7, lastDataRow) +End Sub + +Sub Validate(ByVal rowNum As Long) + Set ws = Me + Dim cValue As String: cValue = Trim(ws.Cells(rowNum, 3).Value) + + ' clear C~I columns background color + Dim clearRange As Range + Set clearRange = ws.Range(ws.Cells(rowNum, START_COL), ws.Cells(rowNum, END_COL)) + clearRange.Interior.Color = vbWhite + + If cValue = "" Then + ws.Cells(rowNum, 2).Value = "C column is required" + ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + + If Len(cValue) <> 3 Then + ws.Cells(rowNum, 2).Value = "C column must be 3 characters" + ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + + Dim i As Long + Dim ch As String + For i = 1 To 3 + ch = Mid(cValue, i, 1) + If Not ((ch >= "0" And ch <= "9") Or (ch >= "A" And ch <= "Z") Or (ch >= "a" And ch <= "z")) Then + ws.Cells(rowNum, 2).Value = "C column must be alphanumeric" + ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + Next i + + Dim dValue As String + dValue = Trim(ws.Cells(rowNum, 4).Value) + If dValue = "" Then + ws.Cells(rowNum, 2).Value = "D column is required" + ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + If Len(dValue) > 80 Then + ws.Cells(rowNum, 2).Value = "D column must be within 80 characters" + ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + + Dim eValue As String + eValue = Trim(ws.Cells(rowNum, 5).Value) + If eValue = "" Then + ws.Cells(rowNum, 2).Value = "E column is required" + ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + If Len(eValue) > 80 Then + ws.Cells(rowNum, 2).Value = "E column must be within 80 characters" + ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + + Dim fValue As String + fValue = Trim(ws.Cells(rowNum, 6).Value) + If fValue <> "" And Len(fValue) > 80 Then + ws.Cells(rowNum, 2).Value = "F column must be within 80 characters" + ws.Cells(rowNum, 6).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + + Dim hValue As String + hValue = Trim(ws.Cells(rowNum, 7).Value) + If hValue <> "" Then + If Len(hValue) <> 1 Then + ws.Cells(rowNum, 2).Value = "G column must be 1 digit" + ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + If hValue <> "0" And hValue <> "1" Then + ws.Cells(rowNum, 2).Value = "G column must be 0 or 1" + ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + End If + + Dim iValue As String + iValue = Trim(ws.Cells(rowNum, 8).Value) + If iValue <> "" And Len(iValue) > 80 Then + ws.Cells(rowNum, 2).Value = "H column must be within 80 characters" + ws.Cells(rowNum, 8).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + + ws.Cells(rowNum, 2).ClearContents +End Sub + +Sub Z4_validateButton() + Dim lastDataRow As Long, r As Long, errorCount As Long + lastDataRow = GetLastDataRowInRange(Me, START_COL, END_COL) + + If lastDataRow < 7 Then + MsgBox "No data found.", vbExclamation + Exit Sub + End If + + errorCount = 0 + For r = 7 To lastDataRow + Validate r + If Trim(Cells(r, ERROR_COL).Value) <> "" Then + errorCount = errorCount + 1 + End If + Next r + + ' === Refresh Z4 cache after validation passes === + If errorCount = 0 Then + Call RefreshZ4Cache + End If + + MsgBox "Validation complete. Errors: " & errorCount, vbInformation +End Sub + +Sub Z4_SortDataRowsByC() + Call SortDataRows(3) +End Sub + +Sub Z4_ToggleAutoFilter() + Call ToggleAutoFilter(2, END_COL) +End Sub + +Sub Z4_AutoFitColumnWidth() + Call AutoFitColumnWidth(2, END_COL) +End Sub \ No newline at end of file diff --git a/src/thisWorkbook/Tukin_C1.bas b/src/thisWorkbook/Tukin_C1.bas index 5725d54..7390910 100644 --- a/src/thisWorkbook/Tukin_C1.bas +++ b/src/thisWorkbook/Tukin_C1.bas @@ -357,13 +357,13 @@ End Function ' Create todoke (G) dropdown Private Function BuildTodokeList() - If todokeList Is Nothing Then Call GetTodokeList + If z4Cache Is Nothing Then Call RefreshZ4Cache Dim dropdownList As String Dim key As Variant - For Each key In todokeList.Keys + For Each key In z4Cache.Keys Dim displayText As String - displayText = MakeSelect(key, todokeList(key)(0)) + displayText = MakeSelect(key, z4Cache(key)(0)) If dropdownList = "" Then dropdownList = displayText Else @@ -411,13 +411,13 @@ End Function ' Create Kettei (AU) dropdown Private Function BuildKetteiList() - If z1Cache Is Nothing Then Call RefreshZ1Cache + If z2Cache Is Nothing Then Call RefreshZ2Cache Dim dropdownList As String Dim key As Variant - For Each key In z1Cache.Keys + For Each key In z2Cache.Keys Dim displayText As String - displayText = MakeSelect(key, z1Cache(key)(0)) + displayText = MakeSelect(key, z2Cache(key)(0)) If dropdownList = "" Then dropdownList = displayText Else @@ -429,13 +429,13 @@ End Function ' Create Higaitou (AW) dropdown Private Function BuildHigaitouList() - If z1Cache Is Nothing Then Call RefreshZ1Cache + If higaitouList Is Nothing Then Call GetHigaitouList Dim dropdownList As String Dim key As Variant - For Each key In z1Cache.Keys + For Each key In higaitouList.Keys Dim displayText As String - displayText = MakeSelect(key, z1Cache(key)(0)) + displayText = MakeSelect(key, higaitouList(key)(0)) If dropdownList = "" Then dropdownList = displayText Else @@ -447,13 +447,13 @@ End Function ' Create MonthAmountKbn (AX) dropdown Private Function BuildMonthAmountKbnList() - If z1Cache Is Nothing Then Call RefreshZ1Cache + If z3Cache Is Nothing Then Call RefreshZ3Cache Dim dropdownList As String Dim key As Variant - For Each key In z1Cache.Keys + For Each key In z3Cache.Keys Dim displayText As String - displayText = MakeSelect(key, z1Cache(key)(0)) + displayText = MakeSelect(key, z3Cache(key)(0)) If dropdownList = "" Then dropdownList = displayText Else @@ -465,13 +465,13 @@ End Function ' Create Kanshoku (BC) dropdown Private Function BuildKanshokuList() - If z1Cache Is Nothing Then Call RefreshZ1Cache + If o2Cache Is Nothing Then Call RefreshO2Cache Dim dropdownList As String Dim key As Variant - For Each key In z1Cache.Keys + For Each key In o2Cache.Keys Dim displayText As String - displayText = MakeSelect(key, z1Cache(key)(0)) + displayText = MakeSelect(key, o2Cache(key)(0)) If dropdownList = "" Then dropdownList = displayText Else diff --git a/通勤手当テンプレート_案.xlsm b/通勤手当テンプレート_案.xlsm index 8427024..ad0bd1c 100644 Binary files a/通勤手当テンプレート_案.xlsm and b/通勤手当テンプレート_案.xlsm differ