diff --git a/src/module/Common_Functions.bas b/src/module/Common_Functions.bas index cb58e8a..135727e 100644 --- a/src/module/Common_Functions.bas +++ b/src/module/Common_Functions.bas @@ -319,3 +319,7 @@ Public Function FormatDateInput(ByVal inputStr As String) As String FormatDateInput = inputStr End If End Function + +Function ColNumToLetter(colNum As Long) As String + ColNumToLetter = Split(Cells(1, colNum).Address, "$")(1) +End Function diff --git a/src/module/Common_Global_Cache.bas b/src/module/Common_Global_Cache.bas index e2d37a5..6dd7acd 100644 --- a/src/module/Common_Global_Cache.bas +++ b/src/module/Common_Global_Cache.bas @@ -381,6 +381,24 @@ Private Sub RefreshSheetDict() Set sheetConfDict = CreateObject("Scripting.Dictionary") Dim sheetConf As Object + ' C1 + Set sheetConf = CreateObject("Scripting.Dictionary") + + sheetConf("StartCol") = "C" + sheetConf("EndCol") = "BC" + sheetConf("ErrorCol") = "BD" + sheetConf("StartRow") = 8 + sheetConf("HeaderRow") = 6 + 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("AlwaysQuote") = False + sheetConf("FilterRow") = 7 + + Set sheetConfDict("C1") = sheetConf + ' M1 Set sheetConf = CreateObject("Scripting.Dictionary") @@ -495,15 +513,15 @@ Private Sub RefreshSheetDict() sheetConf("StartCol") = "C" sheetConf("EndCol") = "F" sheetConf("ErrorCol") = "" - sheetConf("StartRow") = 7 + sheetConf("StartRow") = 6 sheetConf("HeaderRow") = "" sheetConf("RefreshCacheName") = "RefreshO1Cache" sheetConf("CSV_Encoding") = "utf-8" sheetConf("HasHeader") = False - sheetConf("ExpectedColumnCount") = 7 - sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I") + sheetConf("ExpectedColumnCount") = 4 + sheetConf("HeaderColumns") = Array() sheetConf("AlwaysQuote") = True - sheetConf("FilterRow") = 6 + sheetConf("FilterRow") = 5 Set sheetConfDict("O1") = sheetConf @@ -513,15 +531,15 @@ Private Sub RefreshSheetDict() sheetConf("StartCol") = "C" sheetConf("EndCol") = "O" sheetConf("ErrorCol") = "" - sheetConf("StartRow") = 7 + sheetConf("StartRow") = 6 sheetConf("HeaderRow") = "" sheetConf("RefreshCacheName") = "RefreshO2Cache" sheetConf("CSV_Encoding") = "utf-8" sheetConf("HasHeader") = False - sheetConf("ExpectedColumnCount") = 7 - sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I") + sheetConf("ExpectedColumnCount") = 13 + sheetConf("HeaderColumns") = Array() sheetConf("AlwaysQuote") = True - sheetConf("FilterRow") = 6 + sheetConf("FilterRow") = 5 Set sheetConfDict("O2") = sheetConf End Sub diff --git a/src/sheet/C1.cls b/src/sheet/C1.cls index 925b7d8..d9c841b 100644 --- a/src/sheet/C1.cls +++ b/src/sheet/C1.cls @@ -9,32 +9,12 @@ ' - FillKukanFromM1 ' - FillKanshuFromM2 ' - FillCodeFromM2 -' - FillAddressFromO1 +' - CreateAddress1Dropdown ' - FillZ1Dropdown ' ============================================================ ' ====== (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) - ' ============================================================ ' Column arrays for 4 kukan sections ' ============================================================ @@ -67,7 +47,11 @@ Private Function KUKAN_START_DAY_COLS() As Variant End Function Private Function DATE_COLS() As Variant - DATE_COLS = Array(4, 5, 6, 25, 32, 39, 46, 54) ' D, E, F, Y, AF, AM, AT, BB + DATE_COLS = Array(4, 5, 6, 25, 32, 39, 46, 51, 54) ' D, E, F, Y, AF, AM, AT, AY, BB +End Function + +Private Function NUMBER_COLS() As Variant + NUMBER_COLS = Array("L", "P", "Q", "R") End Function ' ============================================================ @@ -123,10 +107,34 @@ Private Sub Worksheet_Change(ByVal Target As Range) If Trim(cell.Value) = "" Then Call ClearRowData(cell.Row) Else - Call FillAddressFromO1(cell.Row) + Call CreateAddress1Dropdown(cell.Row) End If Next End If + + ' auto fill G column [todoke biko] + If Target.Column = 7 Then + Dim cellG As Range + For Each cellG In Target + Dim todoke As String: todoke = Trim(cellG.Value) + If todoke <> "" Then + Dim z4Cache As Object: Set z4Cache = GetZ4Cache() + Dim todokeCde As String: todokeCde = GetCode(todoke) + If z4Cache.Exists(todokeCde) Then + Dim cellH As Range: Set cellH = Me.Cells(cellG.Row, 8) + cellH.Value = z4Cache(todokeCde)(0) + End If + End If + Next + End If + + ' === Column I changes === + If Target.Column = 9 Then + Dim cellI As Range + For Each cellI In Target + Call CreateAddress2Dropdown(cellI.Row) + Next + End If ' === Date columns changes === idx = GetIdx(Target.Column, DATE_COLS) @@ -134,7 +142,14 @@ Private Sub Worksheet_Change(ByVal Target As Range) Dim cellDate As Range For Each cellDate In Target If Trim(cellDate.Value) <> "" Then - cellDate.Value = FormatDateInput(cellDate.Value) + Dim formattedDate As String: formattedDate = FormatDateInput(cellDate.Value) + cellDate.Value = FormatDateInput(formattedDate) + If cellDate.Column = 5 Then + Dim fCell As Range: Set fCell = Me.Cells(cellDate.Row, 6) + If Trim(fCell.Value) = "" Then + fCell.Value = formattedDate + End If + End If End If Next End If @@ -291,8 +306,8 @@ Private Sub FillKukanFromM1(ByVal rowNum As Long, ByVal idx As Long) End If End Sub -' Fill address dropdown from O1 cache -Private Sub FillAddressFromO1(ByVal rowNum As Long) +' triggered by c clomun cshainno input +Private Sub CreateAddress1Dropdown(ByVal rowNum As Long) Dim o1Cache As Object: Set o1Cache = GetO1Cache() Dim empNo As String @@ -314,7 +329,7 @@ Private Sub FillAddressFromO1(ByVal rowNum As Long) Next eKey End If - ' Create dropdown for I column (住所) + ' Create dropdown for I column address1 If dropdownList <> "" Then With Me.Range("I" & rowNum).Validation .Delete @@ -327,7 +342,61 @@ Private Sub FillAddressFromO1(ByVal rowNum As Long) End If End Sub -' Create station (利用区間発) dropdown from M1_KukanD cache +' triggered by address1 select O1 cache +Private Sub CreateAddress2Dropdown(ByVal rowNum As Long) + Dim o1Cache As Object: Set o1Cache = GetO1Cache() + + Dim empNo As String + empNo = Trim(Me.Cells(rowNum, 3).Value) + If empNo = "" Then + Me.Range("J" & rowNum).Validation.Delete + Me.Range("J" & rowNum).Value = "" + Exit Sub + End If + + Dim addr1 As String + addr1 = Trim(Me.Cells(rowNum, 9).Value) + Me.Range("J" & rowNum).Value = "" + If addr1 = "" Then + Me.Range("J" & rowNum).Validation.Delete + Exit Sub + End If + + ' Build dropdown list from O1 cache + Dim dropdownList As String + If o1Cache.Exists(empNo) Then + Dim innerDict As Object + Set innerDict = o1Cache(empNo) + + If innerDict.Exists(addr1) Then + Dim addr2Dict As Object + Set addr2Dict = innerDict(addr1) + + Dim addr2Key As Variant + For Each addr2Key In addr2Dict.Keys + If dropdownList = "" Then + dropdownList = addr2Key + Else + dropdownList = dropdownList & "," & addr2Key + End If + Next addr2Key + End If + End If + + ' Create dropdown for J column + If dropdownList <> "" Then + With Me.Range("J" & rowNum).Validation + .Delete + .Add Type:=xlValidateList, Formula1:=dropdownList + .IgnoreBlank = True + .InCellDropdown = True + .InputTitle = "" + .InputMessage = "" + End With + End If +End Sub + +' Create station from dropdown from M1_KukanD cache Private Sub CreateFromStationDropdown(ByVal rowNum As Long, ByVal transportCol As Long, ByVal stationCol As Long) Dim m1KukanDCache As Object: Set m1KukanDCache = GetM1KukanDCache() @@ -358,7 +427,7 @@ Private Sub CreateFromStationDropdown(ByVal rowNum As Long, ByVal transportCol A End If End Sub -' Create destination (利用区間着) dropdown from M1_KukanD cache +' 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) Dim m1KukanDCache As Object: Set m1KukanDCache = GetM1KukanDCache() @@ -410,7 +479,7 @@ Private Function FindKukanCodeByStation(ByVal rowNum As Long, ByVal transportCol Dim code As Variant For Each code In m1Cache.Keys Dim vals As Variant: vals = m1Cache(code) - ' vals(1) = D列(交通機関区分), vals(3) = F列(発), vals(4) = G列(着) + ' vals(1) = D列, vals(3) = F列, vals(4) = G列 If vals(1) = transportKbn And vals(3) = stationFrom And vals(4) = stationTo Then FindKukanCodeByStation = code Exit Function @@ -425,7 +494,7 @@ Private Sub ClearKukanValidation(ByVal rowNum As Long, ByVal col As Long) Me.Cells(rowNum, col).Validation.Delete End Sub -' Create dropdown from M2 cache: get code (J列) list for kukanCode + kanshu +' Create dropdown from M2 cache: get code (J) list for kukanCode + kanshu Private Sub CreateM2CodeDropdown(ByVal rowNum As Long, ByVal kukanCodeCol As Long, ByVal kanshuCol As Long, ByVal codeCol As Long) Dim m2Cache As Object: Set m2Cache = GetM2Cache() @@ -459,10 +528,25 @@ Private Sub CreateM2CodeDropdown(ByVal rowNum As Long, ByVal kukanCodeCol As Lon End With End If End Sub -' Clear row data + +' Clear row data and validation Private Sub ClearRowData(ByVal rowNum As Long) - Me.Range(Me.Cells(rowNum, 4), Me.Cells(rowNum, END_COL)).ClearContents - Me.Cells(rowNum, ERROR_COL).ClearContents + 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") + + Me.Range(Me.Cells(rowNum, startCol), Me.Cells(rowNum, endCol)).ClearContents + Me.Cells(rowNum, errorCol).ClearContents + + Dim clearValidationCols As Variant + clearValidationCols = Array("I", "J", "U", "V", "X", "AB", "AC", "AE", "AI", "AJ", "AL", "AP", "AQ", "AS") + Dim col As Variant + For Each col In clearValidationCols + Me.Range(col & rowNum).Validation.Delete + Next col End Sub ' Validation logic @@ -480,15 +564,106 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As ' Required columns: C-G, K-N, AW Dim requiredCols As Variant - requiredCols = Array("C", "D", "E", "F", "G", "K", "L", "M", "N", "AW") + requiredCols = Array("C", "D", "E", "F", "G", "L", "M", "N", "AW") Dim col As Variant For Each col In requiredCols If Trim(Me.Range(col & rowNum).Value & "") = "" Then - Me.Cells(rowNum, ERROR_COL).Value = col & " column is required" + Me.Cells(rowNum, errorCol).Value = col & " column is required" Me.Range(col & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If Next col - - Me.Cells(rowNum, ERROR_COL).ClearContents + + ' validate date + Dim colIndex As Variant + For Each colIndex In DATE_COLS() + Dim cellDate As String: cellDate = Trim(Me.Cells(rowNum, colIndex).Value) + If cellDate <> "" And Not IsDate(cellDate) Then + Dim letter As String: letter = Split(Me.Cells(1, colIndex).Address, "$")(1) + Me.Cells(rowNum, errorCol).Value = letter & " column is invalid" + Me.Range(letter & rowNum).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + Next colIndex + + ' validate number + For Each col In NUMBER_COLS() + Dim cellNumber As String: cellNumber = Trim(Me.Cells(rowNum, col).Value) + If cellNumber <> "" And Not IsNumeric(cellNumber) Then + Me.Cells(rowNum, errorCol).Value = col & " column is invalid" + Me.Range(col & rowNum).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + Next col + + ' validate CodeSelect + ' G column [todoke Cde] + Dim ColG As String: ColG = "G" + Dim todoke As String: todoke = Trim(Me.Cells(rowNum, ColG).Value) + If todoke <> "" Then + Dim z4Cache As Object: Set z4Cache = GetZ4Cache() + Dim todokeCde As String: todokeCde = GetCode(todoke) + If Not z4Cache.Exists(todokeCde) Then + Me.Cells(rowNum, errorCol).Value = ColG & " column is invalid" + Me.Range(ColG & rowNum).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + End If + + ' I column [address1 J column address2] + Dim o1Cache As Object: Set o1Cache = GetO1Cache() + Dim ColI As String: ColI = "I" + Dim ColJ As String: ColJ = "J" + Dim address1 As String: address1 = Trim(Me.Cells(rowNum, ColI).Value) + Dim address2 As String: address2 = Trim(Me.Cells(rowNum, ColJ).Value) + If address1 = "" Then + If address2 <> "" Then + Me.Cells(rowNum, errorCol).Value = ColJ & " column is invalid" + Me.Range(ColJ & rowNum).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + Else + Dim empNo As String: empNo = Trim(Me.Cells(rowNum, 3).Value) + If Not o1Cache.Exists(empNo) Then + Me.Cells(rowNum, errorCol).Value = ColI & " column is invalid" + Me.Range(ColI & rowNum).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + + Dim innerDict As Object: Set innerDict = o1Cache(empNo) + If Not innerDict.Exists(address1) Then + Me.Cells(rowNum, errorCol).Value = ColI & " column is invalid" + Me.Range(ColI & rowNum).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + Dim addr2Dict As Object: Set addr2Dict = innerDict(address1) + If Not addr2Dict.Exists(address2) Then + Me.Cells(rowNum, errorCol).Value = ColJ & " column is invalid" + Me.Range(ColJ & rowNum).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + End If + + ' K column + If Trim(Me.Cells(rowNum, "K").Value) <> "" Then + Me.Cells(rowNum, errorCol).Value = "K" & " column can not be input" + Me.Range("K" & rowNum).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + + ' validate CodeSelect + ' M column [todoke Cde] + Dim ColG As String: ColG = "G" + Dim todoke As String: todoke = Trim(Me.Cells(rowNum, ColG).Value) + If todoke <> "" Then + Dim z4Cache As Object: Set z4Cache = GetZ4Cache() + Dim todokeCde As String: todokeCde = GetCode(todoke) + If Not z4Cache.Exists(todokeCde) Then + Me.Cells(rowNum, errorCol).Value = ColG & " column is invalid" + Me.Range(ColG & 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 38f7522..62dd213 100644 Binary files a/通勤手当テンプレート_案.xlsm and b/通勤手当テンプレート_案.xlsm differ diff --git a/通勤手当テンプレート_案.xlsx b/通勤手当テンプレート_案.xlsx deleted file mode 100644 index f8868e0..0000000 Binary files a/通勤手当テンプレート_案.xlsx and /dev/null differ