diff --git a/src/module/Common_File_Utils.bas b/src/module/Common_File_Utils.bas index 4386b13..4df395c 100644 --- a/src/module/Common_File_Utils.bas +++ b/src/module/Common_File_Utils.bas @@ -82,6 +82,7 @@ Sub WriteCSVFromArray( _ ' Escape double quotes: "" represents a single " field = """" & Replace(field, """", """""") & """" End If + field = GetCode(field) fields(j - LBound(data, 2) + 1) = field Next j diff --git a/src/module/Common_Global_Cache.bas b/src/module/Common_Global_Cache.bas index 3a53459..bd5011b 100644 --- a/src/module/Common_Global_Cache.bas +++ b/src/module/Common_Global_Cache.bas @@ -30,6 +30,7 @@ Private oufukuList As Object Private koutaiList As Object Private higaitouList As Object Private kenshuList As Object +Private ninteiKbnList As Object Private sheetConfDict As Object @@ -396,6 +397,24 @@ RefreshError: Err.Raise 1001, "RefreshKenshuList", "Failed to load Enum lookup cache: " & Err.Description End Sub +' ============================================================ +' ninteiKbnList +' ============================================================ +Private Sub RefreshNinteiKbnList() + On Error GoTo RefreshError + Set ninteiKbnList = LoadLookup("Enum", keyCol:=15, valueCols:=Array(16), startRow:=3) + On Error GoTo 0 + + If ninteiKbnList Is Nothing Or ninteiKbnList.Count = 0 Then + Err.Raise 1003, "RefreshNinteiKbnList", "Enum reference data is empty" + End If + + Exit Sub + +RefreshError: + Err.Raise 1001, "RefreshNinteiKbnList", "Failed to load Enum lookup cache: " & Err.Description +End Sub + Private Sub RefreshSheetDict() Set sheetConfDict = CreateObject("Scripting.Dictionary") Dim sheetConf As Object @@ -411,8 +430,8 @@ Private Sub RefreshSheetDict() sheetConf("RefreshCacheName") = "" sheetConf("CSV_Encoding") = "shift_jis" sheetConf("HasHeader") = True - sheetConf("ExpectedColumnCount") = 54 - sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N") + sheetConf("ExpectedColumnCount") = 41 + sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "W", "X", "Y", "Z", "AD", "AE", "AF", "AG", "AK", "AL", "AM", "AN", "AR", "AS", "AT", "AU", "AV", "AW", "AX", "AY", "AZ", "BA", "BB", "BC") sheetConf("AlwaysQuote") = False sheetConf("FilterRow") = 7 @@ -636,4 +655,9 @@ End Function Public Function GetKenshuList() As Object If kenshuList Is Nothing Then Call RefreshKenshuList Set GetKenshuList = kenshuList +End Function + +Public Function GetNinteiKbnList() As Object + If ninteiKbnList Is Nothing Then Call RefreshNinteiKbnList + Set GetNinteiKbnList = ninteiKbnList End Function \ No newline at end of file diff --git a/src/sheet/C1.cls b/src/sheet/C1.cls index e35468d..869fbe1 100644 --- a/src/sheet/C1.cls +++ b/src/sheet/C1.cls @@ -91,12 +91,14 @@ Private Sub Worksheet_Change(ByVal Target As Range) Dim intersectRng As Range: Set intersectRng = Application.Intersect(Target, watchArea) If intersectRng Is Nothing Then Exit Sub - If Target.Row < 7 Then Exit Sub + If Target.Row < 8 Then Exit Sub Dim idx As Long Application.EnableEvents = False On Error GoTo Finally + Call CreateNinteiDropdown(Target) + ' === 3. rebuild dropdown list === Call RebuildDropdownsForTarget(Target) @@ -461,6 +463,33 @@ Private Sub CreateKenshuDropdown(ByVal rowNum As Long, ByVal idx As Long, ByVal End With End Sub +' Create Nintei dropdown from ninteiKbnList if H3 cell Validation does not exist +Private Sub CreateNinteiDropdown(ByVal Target As Range) + Dim ninteiKbnList As Object: Set ninteiKbnList = GetNinteiKbnList() + + ' Build dropdown list from ninteiKbnList + Dim dropdownList As String + Dim key As Variant + For Each key In ninteiKbnList.Keys + Dim displayText As String + displayText = MakeSelect(key, ninteiKbnList(key)(0)) + If dropdownList = "" Then + dropdownList = displayText + Else + dropdownList = dropdownList & "," & displayText + End If + Next key + + If dropdownList <> "" Then + With Me.Range("H3").Validation + .Delete + .Add Type:=xlValidateList, Formula1:=dropdownList + .IgnoreBlank = True + .InCellDropdown = True + End With + End If +End Sub + ' Create destination dropdown from M1_KukanD cache ' Structure: { D: { F: [G] } } Private Sub CreateToStationDropdown(ByVal rowNum As Long, ByVal transportCol As Long, ByVal stationFromCol As Long, ByVal stationToCol As Long) @@ -788,5 +817,62 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As End If Next kukanIdx + ' Validate KUKAN_CODE_COLS for duplicates (non-empty only) + Dim kukanCodes As Object: Set kukanCodes = CreateObject("Scripting.Dictionary") + For kukanIdx = LBound(KUKAN_CODE_COLS) To UBound(KUKAN_CODE_COLS) + kukanCol = KUKAN_CODE_COLS(kukanIdx) + kukanCode = Trim(Me.Cells(rowNum, kukanCol).Value) + If kukanCode <> "" Then + If kukanCodes.Exists(kukanCode) Then + kukanLetter = Split(Me.Cells(1, kukanCol).Address, "$")(1) + Me.Cells(rowNum, errorCol).Value = kukanLetter & " column is duplicated" + Me.Range(kukanLetter & rowNum).Interior.Color = RGB(255, 0, 0) + Exit Sub + Else + kukanCodes.Add kukanCode, True + End If + End If + Next kukanIdx + + ' Validate H, BB, BC columns + Dim ColH As String: ColH = "H" + Dim ColBB As String: ColBB = "BB" + Dim ColBC As String: ColBC = "BC" + Dim codeH As String: codeH = GetCode(Trim(Me.Cells(3, ColH).Value)) + Dim valBB As String: valBB = Trim(Me.Cells(rowNum, ColBB).Value) + Dim valBC As String: valBC = Trim(Me.Cells(rowNum, ColBC).Value) + + Me.Range("H3").Interior.Color = vbWhite + If codeH = "" Then + MsgBox "Please select cell " & ColH & "3 column", vbExclamation + Me.Range("H3").Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + If codeH = "1" Then + ' If code = "1", BB and BC must be empty + If valBB <> "" Then + Me.Cells(rowNum, errorCol).Value = ColBB & " column must be empty" + Me.Range(ColBB & rowNum).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + If valBC <> "" Then + Me.Cells(rowNum, errorCol).Value = ColBC & " column must be empty" + Me.Range(ColBC & rowNum).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + ElseIf codeH = "2" Then + ' If code = "2", BB and BC must have value + If valBB = "" Then + Me.Cells(rowNum, errorCol).Value = ColBB & " column is required" + Me.Range(ColBB & rowNum).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + If valBC = "" Then + Me.Cells(rowNum, errorCol).Value = ColBC & " column is required" + Me.Range(ColBC & rowNum).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + End If + Me.Cells(rowNum, errorCol).ClearContents End Sub diff --git a/通勤手当テンプレート_案.xlsm b/通勤手当テンプレート_案.xlsm index 1999e57..78b9626 100644 Binary files a/通勤手当テンプレート_案.xlsm and b/通勤手当テンプレート_案.xlsm differ