diff --git a/data/区間詳細.csv b/data/区間詳細.csv index 1bbb2a5..848d354 100644 --- a/data/区間詳細.csv +++ b/data/区間詳細.csv @@ -1,12 +1,6 @@ pԃR[h,,R[h,,1ӌ^/̔z,z/P(z)/pz,x/P()/ʗ,ʗ/Q(z),Q(),[(z),ʗ 00001,1,003,Uӌ,7920,47520,6,,,, -00001,2,001,eXg,15000,0,0,0,0,0, -00001,3,001,vyChJ[h,20000,20000,,,,, 00002,1,003,Uӌ,1451.833,8711,6,,,, -00002,2,001,eXg,15000,0,0,0,0,0, -00002,3,002,0002eXg,45000,60000,,,,, -00003,2,002,eXg2,500,500,10,500,10,0, -00004,3,003,0004eXg,5000,5000,,,,, 00005,1,003,Uӌ,4753.333,28520,6,,,, 00006,1,001,Pӌ,7920,7920,1,,,, 00006,1,003,Uӌ,7920,47520,6,,,, @@ -17,4 +11,10 @@ 00068,1,003,Uӌ,52800,316800,6,,,, 00069,1,006,Uӌ,7181.666,43090,6,,,, 00070,1,003,Uӌ,6426.666,38560,6,,,, -00071,1,003,Uӌ,6879,6879,1,,,, \ No newline at end of file +00071,1,003,Uӌ,6879,6879,1,,,, +00001,2,001,eXg,15000,0,0,0,0,0, +00001,3,001,vyChJ[h,20000,20000,,,,, +00002,2,001,eXg,15000,0,0,0,0,0, +00002,3,002,0002eXg,45000,60000,,,,, +00003,2,002,eXg2,500,500,10,500,10,0, +00004,3,003,0004eXg,5000,5000,,,,, \ No newline at end of file diff --git a/src/module/Common_Global_Cache.bas b/src/module/Common_Global_Cache.bas index 833f813..a6cd5ed 100644 --- a/src/module/Common_Global_Cache.bas +++ b/src/module/Common_Global_Cache.bas @@ -285,7 +285,7 @@ Private Sub RefreshT3Cache() Set t3Cache = Nothing On Error GoTo RefreshError - Set t3Cache = LoadLookup("T3", keyCol:=3, valueCols:=Array(4), startRow:=7) + Set t3Cache = LoadLookup("T3", keyCol:=3, valueCols:=Array(4, 8, 9), startRow:=7) On Error GoTo 0 If t3Cache Is Nothing Or t3Cache.Count = 0 Then diff --git a/src/sheet/M2.cls b/src/sheet/M2.cls index 335c404..a268519 100644 --- a/src/sheet/M2.cls +++ b/src/sheet/M2.cls @@ -8,8 +8,23 @@ ' - Validate ' ============================================================ Private Sub Worksheet_Change(ByVal Target As Range) + Dim watchArea As Range + With Me + Set watchArea = Union( _ + .Columns("C"), _ + .Columns("I:R") _ + ) + End With + Dim intersectRng As Range: Set intersectRng = Application.Intersect(Target, watchArea) + If intersectRng Is Nothing Then Exit Sub + + If Target.Row < 7 Then Exit Sub + + Application.EnableEvents = False + On Error GoTo Finally + ' === Fill D, E when C column changes === - If Target.Column = 3 And Target.Row >= 7 Then + If Target.Column = 3 Then Dim cell As Range For Each cell In Target If Trim(cell.Value) = "" Then @@ -21,25 +36,55 @@ Private Sub Worksheet_Change(ByVal Target As Range) End If ' === Create J dropdown when I column changes === - If Target.Column = 9 And Target.Row >= 7 Then + If Target.Column = 9 Then Dim cellI As Range For Each cellI In Target + ' clear + Me.Range(Me.Cells(cellI.Row, 10), Me.Cells(cellI.Row, 18)).ClearContents + Me.Cells(cellI.Row, 11).Validation.Delete + Me.Range(Me.Cells(cellI.Row, 10), Me.Cells(cellI.Row, 18)).Interior.Color = vbWhite Call CreateJDropdown(cellI.Row) Next End If ' === Fill K column when J column changes === - If Target.Column = 10 And Target.Row >= 7 Then + If Target.Column = 10 Then Dim cellJ As Range For Each cellJ In Target Call FillKFromJ(cellJ.Row) Next End If + + Dim kenshuKbn As String: kenshuKbn = Trim(Me.Range("I" & Target.Row).value) + Dim restrictedCols As Range + If kenshuKbn = "1" Then + Set restrictedCols = Union(Me.Columns("K"), Me.Columns("O"), Me.Columns("P"), Me.Columns("Q"), Me.Columns("R")) + If Not Intersect(Target, restrictedCols) Is Nothing Then + Application.EnableEvents = False + MsgBox "can not be input", vbExclamation + Application.Undo + Application.EnableEvents = True + Exit Sub + End If + Else + Set restrictedCols = Me.Range("K:R") ' + If Not Intersect(Target, restrictedCols) Is Nothing Then + Application.EnableEvents = False + MsgBox "can not be input", vbExclamation + Application.Undo + Application.EnableEvents = True + Exit Sub + End If + End If + +Finally: + Application.EnableEvents = True ' End Sub Private Sub FillKFromJ(ByVal rowNum As Long) Dim iValue As String: iValue = Trim(Me.Range("I" & rowNum).Value) Dim jValue As String: jValue = Trim(Me.Range("J" & rowNum).Value) + Dim code As String: code = GetCode(jValue) If jValue = "" Then Me.Range("K" & rowNum).ClearContents @@ -62,13 +107,29 @@ Private Sub FillKFromJ(ByVal rowNum As Long) If cache Is Nothing Then Exit Sub ' Check if J value exists in cache - If cache.Exists(jValue) Then - Dim cacheVal As Variant: cacheVal = cache(jValue) - ' K column = value (第4列) + + If cache.Exists(code) Then + Dim cacheVal As Variant: cacheVal = cache(code) + Me.Range("J" & rowNum).Value = Trim(code) Me.Range("K" & rowNum).Value = Trim(cacheVal(0)) End If - - ' TODO: Add other settings for I=2 and I=3 + + Select Case iValue + Case "1" + Exit Sub + Case "2" + Me.Range("L" & rowNum).Value = Trim(cacheVal(2)) + Me.Range("M" & rowNum).Value = Trim(cacheVal(3)) + Me.Range("N" & rowNum).Value = Trim(cacheVal(4)) + Me.Range("O" & rowNum).Value = Trim(cacheVal(5)) + Me.Range("P" & rowNum).Value = Trim(cacheVal(6)) + Me.Range("Q" & rowNum).Value = Trim(cacheVal(7)) + Case "3" + Me.Range("L" & rowNum).Value = Trim(cacheVal(1)) + Me.Range("M" & rowNum).Value = Trim(cacheVal(2)) + Case Else + Exit Sub + End Select End Sub @@ -85,10 +146,17 @@ Private Sub CreateJDropdown(ByVal rowNum As Long) Select Case iValue Case "1" Set cache = GetT1Cache() + Me.Range("O" & rowNum).Interior.Color = RGB(192, 192, 192) + Me.Range("P" & rowNum).Interior.Color = RGB(192, 192, 192) + Me.Range("Q" & rowNum).Interior.Color = RGB(192, 192, 192) Case "2" Set cache = GetT2Cache() Case "3" Set cache = GetT3Cache() + Me.Range("N" & rowNum).Interior.Color = RGB(192, 192, 192) + Me.Range("O" & rowNum).Interior.Color = RGB(192, 192, 192) + Me.Range("P" & rowNum).Interior.Color = RGB(192, 192, 192) + Me.Range("Q" & rowNum).Interior.Color = RGB(192, 192, 192) Case Else Exit Sub End Select @@ -99,10 +167,11 @@ Private Sub CreateJDropdown(ByVal rowNum As Long) Dim dropdownList As String: dropdownList = "" Dim key As Variant For Each key In cache.Keys + Dim displayText As String: displayText = MakeSelect(key, cache(key)(0)) If dropdownList = "" Then - dropdownList = key + dropdownList = displayText Else - dropdownList = dropdownList & "," & key + dropdownList = dropdownList & "," & displayText End If Next key @@ -187,7 +256,7 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As ' Check column required Dim colLetter As Variant - For Each colLetter In Array("I", "J", "K") + For Each colLetter In Array("I", "J", "K", "L", "M") If Trim(ws.Range(colLetter & rowNum).Value) = "" Then ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E002", colLetter & rowNum) ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0) @@ -216,10 +285,85 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Exit Sub End If - ' check Duplicate - Dim i As Long + ' Check J column in the T1, T2, T3 Dim code As String: code = Trim(ws.Range("J" & rowNum).Value) Dim name As String: name = Trim(ws.Range("K" & rowNum).Value) + Dim valueL As String: valueL = Trim(ws.Range("L" & rowNum).Value) + Dim valueM As String: valueM = Trim(ws.Range("M" & rowNum).Value) + Dim valueN As String: valueN = Trim(ws.Range("N" & rowNum).Value) + Dim valueO As String: valueO = Trim(ws.Range("O" & rowNum).Value) + Dim valueP As String: valueP = Trim(ws.Range("P" & rowNum).Value) + Dim valueQ As String: valueQ = Trim(ws.Range("Q" & rowNum).Value) + Dim cache As Object + Dim requiredCols As Variant + Dim equaledCols As Variant + Dim emptyCols As Variant + If kenshuKbn = "1" Then + Set cache = GetT1Cache() + ' must input + equaledCols = Array("K") + requiredCols = Array("N") + emptyCols = Array("O", "P", "Q", "R") + End If + + If kenshuKbn = "2" Then + Set cache = GetT2Cache() + ' must input + equaledCols = Array("K", "L", "M", "N", "O", "P", "Q") + requiredCols = Array("N", "O", "P", "Q") + emptyCols = Array("R") + End If + + If kenshuKbn = "3" Then + Set cache = GetT3Cache() + ' must input + equaledCols = Array("K", "L", "M") + requiredCols = Array() + emptyCols = Array("N", "O", "P", "Q", "R") + End If + + ' code not exist check + If Not cache.Exists(code) Then + ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E004", "J" & rowNum) + ws.Range("J" & rowNum).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + + ' Dim equaledColIndex As Long + ' For equaledColIndex = 0 To + + ' Dim equaledCol As Variant + ' For Each equaledCol In equaledCols + ' Dim equalValue As String: equalValue = Trim(ws.Range(equaledCol & rowNum).Value) + ' cache + ' If cache(code)(0) <> name Then + ' Exit Sub + ' End If + ' Me.Range(equaledCol & rowNum).Validation.Delete + ' Next equaledCol + + Dim requiredCol As Variant + For Each requiredCol In requiredCols + Dim requiredValue As String: requiredValue = Trim(ws.Range(requiredCol & rowNum).Value) + If requiredValue = "" Then + ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E002", requiredCol & rowNum) + ws.Range(requiredCol & rowNum).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + Next requiredCol + + Dim emptyCol As Variant + For Each emptyCol In emptyCols + Dim emptyValue As String: emptyValue = Trim(ws.Range(emptyCol & rowNum).Value) + If emptyValue <> "" Then + ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E005", emptyCol & rowNum) + ws.Range(emptyCol & rowNum).Interior.Color = RGB(255, 0, 0) + Exit Sub + End If + Next emptyCol + + ' check Duplicate + Dim i As Long For i = 7 To rowNum - 1 If Trim(ws.Cells(i, "C").Value) = cValue And Trim(ws.Cells(i, "I").Value) = kenshuKbn And Trim(ws.Cells(i, "J").Value) = code Then ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E013", i, checkValue) @@ -238,4 +382,5 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As End Sub Sub ImportCSVAndTriggerChange(ws As Worksheet) + ' TODO End Sub diff --git a/通勤手当テンプレート_案.xlsm b/通勤手当テンプレート_案.xlsm index c7a60f9..f453190 100644 Binary files a/通勤手当テンプレート_案.xlsm and b/通勤手当テンプレート_案.xlsm differ