diff --git a/src/module/GlobalCache.bas b/src/module/GlobalCache.bas deleted file mode 100644 index 14b244a..0000000 --- a/src/module/GlobalCache.bas +++ /dev/null @@ -1,58 +0,0 @@ -' ============================================================ -' Modele Name: GlobalCache -' Modele Desc: Global Cache Module, Shared caches across all worksheets -' ============================================================ - -' M1 cache - used by M2_Kukan_detail -Public m1Cache As Object - -' Z1 cache - used by M1_Kukan -Public z1Cache As Object - -' Refresh M1 cache - called when M1 data changes -Public Sub RefreshM1Cache() - ' Clear existing cache first to avoid memory leak - Set m1Cache = Nothing - - On Error GoTo RefreshError - Set m1Cache = LoadLookup("M1", keyCol:=3, valueCols:=Array(3, 4, 5, 6, 7, 9, 12), startRow:=7) - On Error GoTo 0 - - If m1Cache Is Nothing Or m1Cache.Count = 0 Then - Err.Raise 1001, "RefreshM1Cache", "M1 reference data is empty" - End If - - Exit Sub - -RefreshError: - Err.Raise 1002, "RefreshM1Cache", "Failed to load M1 lookup cache: " & Err.Description -End Sub - -' Clear M1 cache - called when M1 data is cleared -Public Sub ClearM1Cache() - Set m1Cache = Nothing -End Sub - -' Refresh Z1 cache - called when Z1 data changes -Public Sub RefreshZ1Cache() - ' Clear existing cache first to avoid memory leak - Set z1Cache = Nothing - - On Error GoTo RefreshError - Set z1Cache = LoadLookup("Z1", keyCol:=3, valueCols:=Array(4), startRow:=7) - On Error GoTo 0 - - If z1Cache Is Nothing Or z1Cache.Count = 0 Then - Err.Raise 1001, "RefreshZ1Cache", "Z1 reference data is empty" - End If - - Exit Sub - -RefreshError: - Err.Raise 1002, "RefreshZ1Cache", "Failed to load Z1 lookup cache: " & Err.Description -End Sub - -' Clear Z1 cache - called when Z1 data is cleared -Public Sub ClearZ1Cache() - Set z1Cache = Nothing -End Sub diff --git a/src/module/Global_Cache.bas b/src/module/Global_Cache.bas new file mode 100644 index 0000000..ad717c9 --- /dev/null +++ b/src/module/Global_Cache.bas @@ -0,0 +1,274 @@ +' ============================================================ +' Modele Name: Global_Cache +' Modele Desc: Global Cache Module, Shared caches across all worksheets +' ============================================================ + +' M1 cache - used by M2_Kukan_detail, Tukin_C1 +Public m1Cache As Object + +' M1_KukanD cache - nested dict {D: {F: [G]}} +Public m1KukanDCache As Object + +' Z1 cache - used by M1_Kukan +Public z1Cache As Object + +' Z2 cache +Public z2Cache As Object + +' Z3 cache +Public z3Cache As Object + +' O1 cache - used by Tukin_C1 +Public o1Cache As Object + +' O2 cache +Public o2Cache As Object + +' M2 cache - nested dictionary for Tukin_C1 +Public m2Cache As Object + +' ============================================================ +' M1 Cache +' ============================================================ +Public Sub RefreshM1Cache() + Set m1Cache = Nothing + + On Error GoTo RefreshError + Set m1Cache = LoadLookup("M1", keyCol:=3, valueCols:=Array(3, 4, 5, 6, 7, 9, 12), startRow:=7) + On Error GoTo 0 + + If m1Cache Is Nothing Or m1Cache.Count = 0 Then + Err.Raise 1001, "RefreshM1Cache", "M1 reference data is empty" + End If + + Exit Sub + +RefreshError: + Err.Raise 1002, "RefreshM1Cache", "Failed to load M1 lookup cache: " & Err.Description +End Sub + +Public Sub ClearM1Cache() + Set m1Cache = Nothing +End Sub + +' Refresh M1_KukanD cache - nested dict {D: {F: [G]}} +' Structure: { 交通機関区分[D]: { 利用区間発名[F]: [利用区間着名G] } } +Public Sub RefreshM1KukanDCache() + Set m1KukanDCache = Nothing + Set m1KukanDCache = CreateObject("Scripting.Dictionary") + + Dim wsM1 As Worksheet + On Error Resume Next + Set wsM1 = ThisWorkbook.Worksheets("M1") + If wsM1 Is Nothing Then Exit Sub + On Error GoTo 0 + + Dim lastRow As Long: lastRow = wsM1.Cells(wsM1.Rows.Count, 3).End(xlUp).Row + If lastRow < 7 Then Exit Sub + + Dim r As Long + For r = 7 To lastRow + Dim dValue As String: dValue = Trim(wsM1.Cells(r, 4).Value) ' D column + Dim fValue As String: fValue = Trim(wsM1.Cells(r, 6).Value) ' F column + Dim gValue As String: gValue = Trim(wsM1.Cells(r, 7).Value) ' G column + + If dValue = "" Or fValue = "" Then GoTo NextRow2 + + ' Outer level: D column (交通機関区分) + If Not m1KukanDCache.Exists(dValue) Then + Dim innerDict As Object: Set innerDict = CreateObject("Scripting.Dictionary") + m1KukanDCache.Add dValue, innerDict + End If + + ' Inner level: F column (利用区間発名) -> array of G values + Set innerDict = m1KukanDCache(dValue) + If Not innerDict.Exists(fValue) Then + Dim arr As Object: Set arr = CreateObject("Scripting.Dictionary") + innerDict.Add fValue, arr + End If + + Set arr = innerDict(fValue) + If gValue <> "" And Not arr.Exists(gValue) Then + arr.Add gValue, True + End If + +NextRow2: + Next r +End Sub + +Public Sub ClearM1KukanDCache() + Set m1KukanDCache = Nothing +End Sub + +' ============================================================ +' M2 Cache - Nested Dictionary +' Structure: { 区間コード[C]: { 券種[I]: { コード[J]: K } } } +' ============================================================ +Public Sub RefreshM2Cache() + Set m2Cache = Nothing + Set m2Cache = CreateObject("Scripting.Dictionary") + + Dim wsM2 As Worksheet + On Error Resume Next + Set wsM2 = ThisWorkbook.Worksheets("M2") + If wsM2 Is Nothing Then Exit Sub + On Error GoTo 0 + + Dim lastRow As Long: lastRow = wsM2.Cells(wsM2.Rows.Count, 3).End(xlUp).Row + If lastRow < 7 Then Exit Sub + + Dim r As Long + For r = 7 To lastRow + Dim kukanCode As String: kukanCode = Trim(wsM2.Cells(r, 3).Value) ' C column + Dim kanshu As String: kanshu = Trim(wsM2.Cells(r, 9).Value) ' I column + Dim code As String: code = Trim(wsM2.Cells(r, 10).Value) ' J column + Dim kValue As String: kValue = Trim(wsM2.Cells(r, 11).Value) ' K column + + If kukanCode = "" Or kanshu = "" Or code = "" Then GoTo NextRow + + ' Outer level: kukanCode + If Not m2Cache.Exists(kukanCode) Then + Dim innerDict As Object: Set innerDict = CreateObject("Scripting.Dictionary") + m2Cache.Add kukanCode, innerDict + End If + + ' Middle level: kanshu + Set innerDict = m2Cache(kukanCode) + If Not innerDict.Exists(kanshu) Then + Dim innermostDict As Object: Set innermostDict = CreateObject("Scripting.Dictionary") + innerDict.Add kanshu, innermostDict + End If + + ' Inner level: code -> kValue + Set innermostDict = innerDict(kanshu) + If Not innermostDict.Exists(code) Then + innermostDict.Add code, kValue + End If + +NextRow: + Next r +End Sub + +Public Sub ClearM2Cache() + Set m2Cache = Nothing +End Sub + +' ============================================================ +' Z1 Cache +' ============================================================ +Public Sub RefreshZ1Cache() + Set z1Cache = Nothing + + On Error GoTo RefreshError + Set z1Cache = LoadLookup("Z1", keyCol:=3, valueCols:=Array(4), startRow:=7) + On Error GoTo 0 + + If z1Cache Is Nothing Or z1Cache.Count = 0 Then + Err.Raise 1001, "RefreshZ1Cache", "Z1 reference data is empty" + End If + + Exit Sub + +RefreshError: + Err.Raise 1002, "RefreshZ1Cache", "Failed to load Z1 lookup cache: " & Err.Description +End Sub + +Public Sub ClearZ1Cache() + Set z1Cache = Nothing +End Sub + +' ============================================================ +' Z2 Cache +' ============================================================ +Public Sub RefreshZ2Cache() + Set z2Cache = Nothing + + On Error GoTo RefreshError + Set z2Cache = LoadLookup("Z2", keyCol:=3, valueCols:=Array(4), startRow:=7) + On Error GoTo 0 + + If z2Cache Is Nothing Or z2Cache.Count = 0 Then + Err.Raise 1001, "RefreshZ2Cache", "Z2 reference data is empty" + End If + + Exit Sub + +RefreshError: + Err.Raise 1002, "RefreshZ2Cache", "Failed to load Z2 lookup cache: " & Err.Description +End Sub + +Public Sub ClearZ2Cache() + Set z2Cache = Nothing +End Sub + +' ============================================================ +' Z3 Cache +' ============================================================ +Public Sub RefreshZ3Cache() + Set z3Cache = Nothing + + On Error GoTo RefreshError + Set z3Cache = LoadLookup("Z3", keyCol:=3, valueCols:=Array(4), startRow:=7) + On Error GoTo 0 + + If z3Cache Is Nothing Or z3Cache.Count = 0 Then + Err.Raise 1001, "RefreshZ3Cache", "Z3 reference data is empty" + End If + + Exit Sub + +RefreshError: + Err.Raise 1002, "RefreshZ3Cache", "Failed to load Z3 lookup cache: " & Err.Description +End Sub + +Public Sub ClearZ3Cache() + Set z3Cache = Nothing +End Sub + +' ============================================================ +' O1 Cache +' ============================================================ +Public Sub RefreshO1Cache() + Set o1Cache = Nothing + + On Error GoTo RefreshError + Set o1Cache = LoadLookup("O1", keyCol:=3, valueCols:=Array(5, 6), startRow:=7) + On Error GoTo 0 + + If o1Cache Is Nothing Or o1Cache.Count = 0 Then + Err.Raise 1001, "RefreshO1Cache", "O1 reference data is empty" + End If + + Exit Sub + +RefreshError: + Err.Raise 1002, "RefreshO1Cache", "Failed to load O1 lookup cache: " & Err.Description +End Sub + +Public Sub ClearO1Cache() + Set o1Cache = Nothing +End Sub + +' ============================================================ +' O2 Cache +' ============================================================ +Public Sub RefreshO2Cache() + Set o2Cache = Nothing + + On Error GoTo RefreshError + Set o2Cache = LoadLookup("O2", keyCol:=3, valueCols:=Array(4), startRow:=7) + On Error GoTo 0 + + If o2Cache Is Nothing Or o2Cache.Count = 0 Then + Err.Raise 1001, "RefreshO2Cache", "O2 reference data is empty" + End If + + Exit Sub + +RefreshError: + Err.Raise 1002, "RefreshO2Cache", "Failed to load O2 lookup cache: " & Err.Description +End Sub + +Public Sub ClearO2Cache() + Set o2Cache = Nothing +End Sub diff --git a/src/module/Test_Cache.bas b/src/module/Test_Cache.bas new file mode 100644 index 0000000..e4e12ed --- /dev/null +++ b/src/module/Test_Cache.bas @@ -0,0 +1,194 @@ +' ============================================================ +' Test Cache Module +' Debug: Print cache contents to Test_Cache sheet +' ============================================================ + +Sub Test_PrintAllCaches() + ' Refresh all caches first + Call RefreshM1Cache + Call RefreshM1KukanDCache + Call RefreshM2Cache + Call RefreshZ1Cache + Call RefreshO1Cache + + ' Get or create Test_Cache sheet + Dim wb As Workbook + Set wb = ThisWorkbook + + Dim ws As Worksheet + On Error Resume Next + Set ws = wb.Worksheets("Test_Cache") + On Error GoTo 0 + + If ws Is Nothing Then + Set ws = wb.Worksheets.Add + ws.Name = "Test_Cache" + End If + + ws.Cells.Clear + + Dim row As Long + row = 1 + + ' Print M1 Cache + ws.Cells(row, 1).Value = "=== M1 Cache ===" + row = row + 1 + Call PrintM1CacheToSheet(ws, row) + + ' Print M1_KukanD Cache + row = row + 1 + ws.Cells(row, 1).Value = "=== M1_KukanD Cache ===" + row = row + 1 + Call PrintM1KukanDCacheToSheet(ws, row) + + ' Print M2 Cache + row = row + 1 + ws.Cells(row, 1).Value = "=== M2 Cache ===" + row = row + 1 + Call PrintM2CacheToSheet(ws, row) + + ' Print Z1 Cache + row = row + 1 + ws.Cells(row, 1).Value = "=== Z1 Cache ===" + row = row + 1 + Call PrintZ1CacheToSheet(ws, row) + + ' Print O1 Cache + row = row + 1 + ws.Cells(row, 1).Value = "=== O1 Cache ===" + row = row + 1 + Call PrintO1CacheToSheet(ws, row) + + ws.Columns.AutoFit +End Sub + +Private Sub PrintM1CacheToSheet(ws As Worksheet, ByRef row As Long) + If m1Cache Is Nothing Then + ws.Cells(row, 1).Value = "m1Cache is Nothing" + row = row + 1 + Exit Sub + End If + + ws.Cells(row, 1).Value = "Count: " & m1Cache.Count + row = row + 1 + + Dim key As Variant + For Each key In m1Cache.Keys + Dim vals As Variant + vals = m1Cache(key) + ws.Cells(row, 1).Value = key + ws.Cells(row, 2).Value = vals(1) & ": " & vals(2) + ws.Cells(row, 3).Value = vals(3) + ws.Cells(row, 4).Value = vals(4) + ws.Cells(row, 5).Value = vals(5) + row = row + 1 + Next key +End Sub + +Private Sub PrintM1KukanDCacheToSheet(ws As Worksheet, ByRef row As Long) + If m1KukanDCache Is Nothing Then + ws.Cells(row, 1).Value = "m1KukanDCache is Nothing" + row = row + 1 + Exit Sub + End If + + ws.Cells(row, 1).Value = "Count: " & m1KukanDCache.Count + row = row + 1 + + Dim dKey As Variant + For Each dKey In m1KukanDCache.Keys + ws.Cells(row, 1).Value = "D: " & dKey + row = row + 1 + + Dim innerDict As Object + Set innerDict = m1KukanDCache(dKey) + Dim fKey As Variant + For Each fKey In innerDict.Keys + ws.Cells(row, 2).Value = "F: " & fKey + row = row + 1 + + Dim arr As Object + Set arr = innerDict(fKey) + Dim gKey As Variant + For Each gKey In arr.Keys + ws.Cells(row, 3).Value = "G: " & gKey + row = row + 1 + Next gKey + Next fKey + Next dKey +End Sub + +Private Sub PrintM2CacheToSheet(ws As Worksheet, ByRef row As Long) + If m2Cache Is Nothing Then + ws.Cells(row, 1).Value = "m2Cache is Nothing" + row = row + 1 + Exit Sub + End If + + ws.Cells(row, 1).Value = "Count: " & m2Cache.Count + row = row + 1 + + Dim kukanKey As Variant + For Each kukanKey In m2Cache.Keys + ws.Cells(row, 1).Value = "KukanCode: " & kukanKey + row = row + 1 + + Dim innerDict As Object + Set innerDict = m2Cache(kukanKey) + Dim kanshuKey As Variant + For Each kanshuKey In innerDict.Keys + ws.Cells(row, 2).Value = "Kanshu: " & kanshuKey + row = row + 1 + + Dim innermostDict As Object + Set innermostDict = innerDict(kanshuKey) + Dim codeKey As Variant + For Each codeKey In innermostDict.Keys + ws.Cells(row, 3).Value = "Code: " & codeKey + ws.Cells(row, 4).Value = innermostDict(codeKey) + row = row + 1 + Next codeKey + Next kanshuKey + Next kukanKey +End Sub + +Private Sub PrintZ1CacheToSheet(ws As Worksheet, ByRef row As Long) + If z1Cache Is Nothing Then + ws.Cells(row, 1).Value = "z1Cache is Nothing" + row = row + 1 + Exit Sub + End If + + ws.Cells(row, 1).Value = "Count: " & z1Cache.Count + row = row + 1 + + Dim key As Variant + For Each key In z1Cache.Keys + Dim vals As Variant + vals = z1Cache(key) + ws.Cells(row, 1).Value = key + ws.Cells(row, 2).Value = vals(0) + row = row + 1 + Next key +End Sub + +Private Sub PrintO1CacheToSheet(ws As Worksheet, ByRef row As Long) + If o1Cache Is Nothing Then + ws.Cells(row, 1).Value = "o1Cache is Nothing" + row = row + 1 + Exit Sub + End If + + ws.Cells(row, 1).Value = "Count: " & o1Cache.Count + row = row + 1 + + Dim key As Variant + For Each key In o1Cache.Keys + Dim vals As Variant + vals = o1Cache(key) + ws.Cells(row, 1).Value = key + ws.Cells(row, 2).Value = vals(0) + ws.Cells(row, 3).Value = vals(1) + row = row + 1 + Next key +End Sub diff --git a/src/thisWorkbook/Master_Z2_223.bas b/src/thisWorkbook/Master_Z2_223.bas index 6873273..35f8430 100644 --- a/src/thisWorkbook/Master_Z2_223.bas +++ b/src/thisWorkbook/Master_Z2_223.bas @@ -135,6 +135,11 @@ Sub Z2_validateButton() End If Next r + ' === Refresh Z2 cache after validation passes === + If errorCount = 0 Then + Call RefreshZ2Cache + End If + MsgBox "Validation complete. Errors: " & errorCount, vbInformation End Sub diff --git a/src/thisWorkbook/Master_Z3_224.bas b/src/thisWorkbook/Master_Z3_224.bas index 84fd579..8d56a40 100644 --- a/src/thisWorkbook/Master_Z3_224.bas +++ b/src/thisWorkbook/Master_Z3_224.bas @@ -143,6 +143,11 @@ Sub Z3_validateButton() End If Next r + ' === Refresh Z3 cache after validation passes === + If errorCount = 0 Then + Call RefreshZ3Cache + End If + MsgBox "Validation complete. Errors: " & errorCount, vbInformation End Sub diff --git a/src/thisWorkbook/Tukin_C1.bas b/src/thisWorkbook/Tukin_C1.bas new file mode 100644 index 0000000..d0d8ec4 --- /dev/null +++ b/src/thisWorkbook/Tukin_C1.bas @@ -0,0 +1,540 @@ +' ====== (Tukin_C1) ======= +' Commuter allowance editing sheet +' No CSV import - direct editing only + +' ====== Constants ====== +Const START_COL As Long = 3 ' C column (职员番号) +Const END_COL As Long = 56 ' BC column +Const ERROR_COL As Long = 57 ' BD column +Const Tukin_HEADER_ROW As Long = 6 + +' Column regions (for reference) +' D-H: 届出情報 (cols 4-8) +' I-J: 住所情報 (cols 9-10) +' K-O: 出勤情報 (cols 11-15) +' P-R: 自動車等情報 (cols 16-18) +' S-Y: 区間１情報 (cols 19-25) +' Z-AF: 区間２情報 (cols 26-32) +' AG-AM: 区間３情報 (cols 33-39) +' AN-AT: 区間４情報 (cols 40-46) +' AU-AX: 決定事項情報 (cols 47-50) +' AY-BA: 備考情報 (cols 51-53) +' BB-BC: 認定情報 (cols 54-56) + +' ====== Event Handlers ====== +Private Sub Worksheet_Change(ByVal Target As Range) + ' === Column C changes: Fill address info from O1 and Z1 cache === + If Target.Column = 3 And Target.Row >= 7 Then + Dim cell As Range + For Each cell In Target + If Trim(cell.Value) = "" Then + Call ClearRowData(Me, cell.Row) + Else + Call FillAddressFromO1(cell.Row) + ' Generate transport (T) dropdown for all 4 kukan sections + Call CreateZ1TransportDropdown(Me, cell.Row, 20) ' 区間1 - T column + Call CreateZ1TransportDropdown(Me, cell.Row, 30) ' 区間2 - AD column + Call CreateZ1TransportDropdown(Me, cell.Row, 37) ' 区間3 - AK column + Call CreateZ1TransportDropdown(Me, cell.Row, 44) ' 区間4 - AR column + End If + Next + End If + + ' === Column T (区間1 交通機関) changes: Generate U (利用区間発) dropdown from Z1 === + If Target.Column = 20 And Target.Row >= 7 Then + Dim cellT As Range + For Each cellT In Target + If Trim(cellT.Value) <> "" Then + Call CreateZ1StationDropdown(Me, cellT.Row, 20, 21, 1) + Else + Call ClearKukanValidation(Me, cellT.Row, 21) + End If + Next + End If + + ' === Column U (区間1 利用区間発) changes: Generate V (利用区間着) dropdown from M1_KukanD === + If Target.Column = 21 And Target.Row >= 7 Then + Dim cellU As Range + For Each cellU In Target + If Trim(cellU.Value) <> "" Then + Call CreateM1KukanDDropdown(Me, cellU.Row, 20, 21, 22) + If Me.Cells(cellU.Row, 22).Validation.Formula1 = "" Then + ' No dropdown data, clear V column + Call ClearKukanValidation(Me, cellU.Row, 22) + End If + Else + Call ClearKukanValidation(Me, cellU.Row, 22) + End If + Next + End If + + ' === Column AD (区間2 交通機関) changes === + If Target.Column = 30 And Target.Row >= 7 Then + Dim cellAD As Range + For Each cellAD In Target + If Trim(cellAD.Value) <> "" Then + Call CreateZ1StationDropdown(Me, cellAD.Row, 30, 31) + Else + Call ClearKukanValidation(Me, cellAD.Row, 31) + End If + Next + End If + + ' === Column AE (区間2 利用区間発) changes === + If Target.Column = 31 And Target.Row >= 7 Then + Dim cellAE As Range + For Each cellAE In Target + If Trim(cellAE.Value) <> "" Then + Call CreateM1KukanDDropdown(Me, cellAE.Row, 30, 31, 32) + If Me.Cells(cellAE.Row, 32).Validation.Formula1 = "" Then + Call ClearKukanValidation(Me, cellAE.Row, 32) + End If + Else + Call ClearKukanValidation(Me, cellAE.Row, 32) + End If + Next + End If + + ' === Column AK (区間3 交通機関) changes === + If Target.Column = 37 And Target.Row >= 7 Then + Dim cellAK As Range + For Each cellAK In Target + If Trim(cellAK.Value) <> "" Then + Call CreateZ1StationDropdown(Me, cellAK.Row, 37, 38) + Else + Call ClearKukanValidation(Me, cellAK.Row, 38) + End If + Next + End If + + ' === Column AL (区間3 利用区間発) changes === + If Target.Column = 38 And Target.Row >= 7 Then + Dim cellAL As Range + For Each cellAL In Target + If Trim(cellAL.Value) <> "" Then + Call CreateM1KukanDDropdown(Me, cellAL.Row, 37, 38, 39) + If Me.Cells(cellAL.Row, 39).Validation.Formula1 = "" Then + Call ClearKukanValidation(Me, cellAL.Row, 39) + End If + Else + Call ClearKukanValidation(Me, cellAL.Row, 39) + End If + Next + End If + + ' === Column AR (区間4 交通機関) changes === + If Target.Column = 44 And Target.Row >= 7 Then + Dim cellAR As Range + For Each cellAR In Target + If Trim(cellAR.Value) <> "" Then + Call CreateZ1StationDropdown(Me, cellAR.Row, 44, 45) + Else + Call ClearKukanValidation(Me, cellAR.Row, 45) + End If + Next + End If + + ' === Column AS (区間4 利用区間発) changes === + If Target.Column = 45 And Target.Row >= 7 Then + Dim cellAS As Range + For Each cellAS In Target + If Trim(cellAS.Value) <> "" Then + Call CreateM1KukanDDropdown(Me, cellAS.Row, 44, 45, 46) + If Me.Cells(cellAS.Row, 46).Validation.Formula1 = "" Then + Call ClearKukanValidation(Me, cellAS.Row, 46) + End If + Else + Call ClearKukanValidation(Me, cellAS.Row, 46) + End If + Next + End If + + ' === Column S changes: Fill 区間１ from M1/M2 cache === + If Target.Column = 19 And Target.Row >= 7 Then + Dim cellS As Range + For Each cellS In Target + If Trim(cellS.Value) <> "" Then + ' First check if T column has dropdown data + Call CreateZ1TransportDropdown(Me, cellS.Row, 20) + If Me.Cells(cellS.Row, 20).Validation.Formula1 <> "" Then + Call FillKukanFromM1(Me, cellS.Row, 19, Array(20, 21, 22)) ' S->T,U,V + Call CreateM2Dropdown(Me, cellS.Row, 19, 23) ' S->W dropdown (券種) + End If + Else + Call ClearKukanValidation(Me, cellS.Row, 23) + End If + Next + End If + + ' === Column W changes: Fill 券種 dropdown -> generate X dropdown === + If Target.Column = 23 And Target.Row >= 7 Then + Dim cellW As Range + For Each cellW In Target + If Trim(cellW.Value) <> "" Then + Call CreateM2CodeDropdown(Me, cellW.Row, 19, 23, 24) ' kukanCode, kanshu -> X dropdown + Else + Call ClearKukanValidation(Me, cellW.Row, 24) + End If + Next + End If + + ' === Column Z changes: Fill 区間２ from M1/M2 cache === + If Target.Column = 26 And Target.Row >= 7 Then + Dim cellZ As Range + For Each cellZ In Target + If Trim(cellZ.Value) <> "" Then + Call CreateZ1TransportDropdown(Me, cellZ.Row, 30) + If Me.Cells(cellZ.Row, 30).Validation.Formula1 <> "" Then + Call FillKukanFromM1(Me, cellZ.Row, 26, Array(27, 28, 29)) ' Z->AA,AB,AC + Call CreateM2Dropdown(Me, cellZ.Row, 26, 30) ' Z->AD dropdown + End If + Else + Call ClearKukanValidation(Me, cellZ.Row, 30) + End If + Next + End If + + ' === Column AD changes: Fill 券種 dropdown -> generate AH dropdown === + If Target.Column = 30 And Target.Row >= 7 Then + Dim cellAD As Range + For Each cellAD In Target + If Trim(cellAD.Value) <> "" Then + Call CreateM2CodeDropdown(Me, cellAD.Row, 26, 30, 31) ' kukanCode, kanshu -> AH dropdown + Else + Call ClearKukanValidation(Me, cellAD.Row, 31) + End If + Next + End If + + ' === Column AG changes: Fill 区間３ from M1/M2 cache === + If Target.Column = 33 And Target.Row >= 7 Then + Dim cellAG As Range + For Each cellAG In Target + If Trim(cellAG.Value) <> "" Then + Call CreateZ1TransportDropdown(Me, cellAG.Row, 37) + If Me.Cells(cellAG.Row, 37).Validation.Formula1 <> "" Then + Call FillKukanFromM1(Me, cellAG.Row, 33, Array(34, 35, 36)) ' AG->AH,AI,AJ + Call CreateM2Dropdown(Me, cellAG.Row, 33, 37) ' AG->AK dropdown + End If + Else + Call ClearKukanValidation(Me, cellAG.Row, 37) + End If + Next + End If + + ' === Column AK changes: Fill 券種 dropdown -> generate AL dropdown === + If Target.Column = 37 And Target.Row >= 7 Then + Dim cellAK As Range + For Each cellAK In Target + If Trim(cellAK.Value) <> "" Then + Call CreateM2CodeDropdown(Me, cellAK.Row, 33, 37, 38) ' kukanCode, kanshu -> AL dropdown + Else + Call ClearKukanValidation(Me, cellAK.Row, 38) + End If + Next + End If + + ' === Column AN changes: Fill 区間４ from M1/M2 cache === + If Target.Column = 40 And Target.Row >= 7 Then + Dim cellAN As Range + For Each cellAN In Target + If Trim(cellAN.Value) <> "" Then + Call CreateZ1TransportDropdown(Me, cellAN.Row, 44) + If Me.Cells(cellAN.Row, 44).Validation.Formula1 <> "" Then + Call FillKukanFromM1(Me, cellAN.Row, 40, Array(41, 42, 43)) ' AN->AO,AP,AQ + Call CreateM2Dropdown(Me, cellAN.Row, 40, 44) ' AN->AR dropdown + End If + Else + Call ClearKukanValidation(Me, cellAN.Row, 44) + End If + Next + End If + + ' === Column AR changes: Fill 券種 dropdown -> generate AS dropdown === + If Target.Column = 44 And Target.Row >= 7 Then + Dim cellAR As Range + For Each cellAR In Target + If Trim(cellAR.Value) <> "" Then + Call CreateM2CodeDropdown(Me, cellAR.Row, 40, 44, 45) ' kukanCode, kanshu -> AS dropdown + Else + Call ClearKukanValidation(Me, cellAR.Row, 45) + End If + Next + End If +End Sub + +' Fill kukan info from M1 cache (key: kukan code, value: 7 elements) +Private Sub FillKukanFromM1(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal codeCol As Long, ByVal fillCols As Variant) + If m1Cache Is Nothing Then Call RefreshM1Cache + + Dim code As String: code = Trim(ws.Cells(rowNum, codeCol).Value) + If code = "" Then Exit Sub + + If m1Cache.Exists(code) Then + Dim vals As Variant: vals = m1Cache(code) + ' value(1):value(2) -> fillCols(0) + ws.Cells(rowNum, fillCols(0)).Value = Trim(vals(1)) & ": " & Trim(vals(2)) + ' value(3) -> fillCols(1) + ws.Cells(rowNum, fillCols(1)).Value = Trim(vals(3)) + ' value(4) -> fillCols(2) + ws.Cells(rowNum, fillCols(2)).Value = Trim(vals(4)) + Else + ws.Cells(rowNum, codeCol).ClearContents + End If +End Sub + +' Create dropdown from M2 cache for ticket type column +Private Sub CreateM2Dropdown(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal kukanCodeCol As Long, ByVal ticketCol As Long) + If m2Cache Is Nothing Then Call RefreshM2Cache + + Dim kukanCode As String: kukanCode = Trim(ws.Cells(rowNum, kukanCodeCol).Value) + If kukanCode = "" Then Exit Sub + + ' Build dropdown list: get all kanshu (券種) for the kukanCode + Dim dropdownList As String + If m2Cache.Exists(kukanCode) Then + Dim innerDict As Object: Set innerDict = m2Cache(kukanCode) + Dim kanshu As Variant + For Each kanshu In innerDict.Keys + If dropdownList = "" Then + dropdownList = kanshu + Else + dropdownList = dropdownList & "," & kanshu + End If + Next kanshu + End If + + If dropdownList <> "" Then + With ws.Range(ws.Cells(rowNum, ticketCol).Address).Validation + .Delete + .Add Type:=xlValidateList, Formula1:=dropdownList + .IgnoreBlank = True + .InCellDropdown = True + .InputTitle = "" + .InputMessage = "" + End With + End If +End Sub + +' Fill address dropdown from O1 cache +Private Sub FillAddressFromO1(ByVal rowNum As Long) + If o1Cache Is Nothing Then Call RefreshO1Cache + + Dim empNo As String: empNo = Trim(Me.Cells(rowNum, 3).Value) + If empNo = "" Then Exit Sub + + ' Build dropdown list from O1 cache + Dim dropdownList As String + Dim key As Variant + For Each key In o1Cache.Keys + If dropdownList = "" Then + dropdownList = key + Else + dropdownList = dropdownList & "," & key + End If + Next key + + ' Create dropdown for I column (住所) + With Me.Range("I" & rowNum).Validation + .Delete + .Add Type:=xlValidateList, Formula1:=dropdownList + .IgnoreBlank = True + .InCellDropdown = True + .InputTitle = "" + .InputMessage = "" + End With +End Sub + +' Create transport (T) dropdown from Z1 cache +Private Sub CreateZ1TransportDropdown(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal col As Long) + If z1Cache Is Nothing Then Call RefreshZ1Cache + + ' Build dropdown list from Z1 cache keys + Dim dropdownList As String + Dim key As Variant + For Each key In z1Cache.Keys + If dropdownList = "" Then + dropdownList = key + Else + dropdownList = dropdownList & "," & key + End If + Next key + + If dropdownList <> "" Then + With ws.Cells(rowNum, col).Validation + .Delete + .Add Type:=xlValidateList, Formula1:=dropdownList + .IgnoreBlank = True + .InCellDropdown = True + .InputTitle = "" + .InputMessage = "" + End With + End If +End Sub + +' Create station (利用区間発) dropdown from M1_KukanD cache +Private Sub CreateZ1StationDropdown(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal transportCol As Long, ByVal stationCol As Long) + If m1KukanDCache Is Nothing Then Call RefreshM1KukanDCache + + Dim transport As String: transport = Trim(ws.Cells(rowNum, transportCol).Value) + If transport = "" Then Exit Sub + + ' Build dropdown list from M1_KukanD cache: get all F values for the transport (D) + Dim dropdownList As String + If m1KukanDCache.Exists(transport) Then + Dim innerDict As Object: Set innerDict = m1KukanDCache(transport) + Dim fValue As Variant + For Each fValue In innerDict.Keys + If dropdownList = "" Then + dropdownList = fValue + Else + dropdownList = dropdownList & "," & fValue + End If + Next fValue + End If + + If dropdownList <> "" Then + With ws.Cells(rowNum, stationCol).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 CreateM1KukanDDropdown(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal transportCol As Long, ByVal stationFromCol As Long, ByVal stationToCol As Long) + If m1KukanDCache Is Nothing Then Call RefreshM1KukanDCache + + Dim transport As String: transport = Trim(ws.Cells(rowNum, transportCol).Value) + Dim stationFrom As String: stationFrom = Trim(ws.Cells(rowNum, stationFromCol).Value) + If transport = "" Or stationFrom = "" Then Exit Sub + + ' Build dropdown list from M1_KukanD cache + Dim dropdownList As String + If m1KukanDCache.Exists(transport) Then + Dim innerDict As Object: Set innerDict = m1KukanDCache(transport) + If innerDict.Exists(stationFrom) Then + Dim arr As Object: Set arr = innerDict(stationFrom) + Dim gValue As Variant + For Each gValue In arr.Keys + If dropdownList = "" Then + dropdownList = gValue + Else + dropdownList = dropdownList & "," & gValue + End If + Next gValue + End If + End If + + If dropdownList <> "" Then + With ws.Cells(rowNum, stationToCol).Validation + .Delete + .Add Type:=xlValidateList, Formula1:=dropdownList + .IgnoreBlank = True + .InCellDropdown = True + End With + End If +End Sub + +' Clear validation for kukan columns +Private Sub ClearKukanValidation(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal col As Long) + ws.Cells(rowNum, col).Validation.Delete +End Sub + +' Create dropdown from M2 cache: get code (J列) list for kukanCode + kanshu +Private Sub CreateM2CodeDropdown(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal kukanCodeCol As Long, ByVal kanshuCol As Long, ByVal codeCol As Long) + If m2Cache Is Nothing Then Call RefreshM2Cache + + Dim kukanCode As String: kukanCode = Trim(ws.Cells(rowNum, kukanCodeCol).Value) + Dim kanshu As String: kanshu = Trim(ws.Cells(rowNum, kanshuCol).Value) + If kukanCode = "" Or kanshu = "" Then Exit Sub + + ' Build dropdown list: get all code for kukanCode + kanshu + Dim dropdownList As String + If m2Cache.Exists(kukanCode) Then + Dim innerDict As Object: Set innerDict = m2Cache(kukanCode) + If innerDict.Exists(kanshu) Then + Dim innermostDict As Object: Set innermostDict = innerDict(kanshu) + Dim code As Variant + For Each code In innermostDict.Keys + If dropdownList = "" Then + dropdownList = code + Else + dropdownList = dropdownList & "," & code + End If + Next code + End If + End If + + If dropdownList <> "" Then + With ws.Cells(rowNum, codeCol).Validation + .Delete + .Add Type:=xlValidateList, Formula1:=dropdownList + .IgnoreBlank = True + .InCellDropdown = True + End With + End If +End Sub +' Clear row data +Private Sub ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long) + ws.Range(ws.Cells(rowNum, 4), ws.Cells(rowNum, END_COL)).ClearContents + ws.Cells(rowNum, ERROR_COL).ClearContents +End Sub + +' ====== Button Macros ====== +Sub C1_validateButton() + Dim lastRow As Long, r As Long, errorCount As Long + lastRow = GetLastDataRowInRange(Me, START_COL, END_COL) + + If lastRow < 7 Then + MsgBox "No data found.", vbExclamation + Exit Sub + End If + + errorCount = 0 + For r = 7 To lastRow + Call Validate(r) + If Trim(Cells(r, ERROR_COL).Value) <> "" Then + errorCount = errorCount + 1 + End If + Next r + + MsgBox "Validation complete. Errors: " & errorCount, vbInformation +End Sub + +' Validation logic +Private Sub Validate(ByVal rowNum As Long) + Set ws = Me + + ' Clear background color + ws.Range(ws.Cells(rowNum, START_COL), ws.Cells(rowNum, END_COL)).Interior.Color = vbWhite + + ' Required columns: C-G, K-N, AW + Dim requiredCols As Variant + requiredCols = Array("C", "D", "E", "F", "G", "K", "L", "M", "N", "AW") + Dim col As Variant + For Each col In requiredCols + If Trim(ws.Range(col & rowNum).Value & "") = "" Then + ws.Cells(rowNum, ERROR_COL).Value = col & " column is required" + ws.Range(col & rowNum).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + Next col + + ws.Cells(rowNum, ERROR_COL).ClearContents +End Sub + +Sub C1_SortDataRowsByC() + Call SortDataRows(3) +End Sub + +Sub C1_ToggleAutoFilter() + Call ToggleAutoFilter(START_COL, END_COL) +End Sub + +Sub C1_AutoFitColumnWidth() + Call AutoFitColumnWidth(START_COL, END_COL) +End Sub diff --git a/通勤手当テンプレート_案.xlsm b/通勤手当テンプレート_案.xlsm index ec6152f..9bd14c9 100644 Binary files a/通勤手当テンプレート_案.xlsm and b/通勤手当テンプレート_案.xlsm differ