M2 update

data/区間詳細.csv

@@ -1,12 +1,6 @@
 利用区間コード,券種,コード,名称,1箇月運賃/販売額,定期額/券１(額)/利用額,定期支給期間/券１(枚)/特別料金,特別料金/券２(額),券２(枚),端数(額),特別料金
 00001,1,003,６箇月定期,7920,47520,6,,,,
-00001,2,001,テスト,15000,0,0,0,0,0,
-00001,3,001,プリペイドカード,20000,20000,,,,,
 00002,1,003,６箇月定期,1451.833,8711,6,,,,
-00002,2,001,テスト,15000,0,0,0,0,0,
-00002,3,002,0002テスト,45000,60000,,,,,
-00003,2,002,テスト2,500,500,10,500,10,0,
-00004,3,003,0004テスト,5000,5000,,,,,
 00005,1,003,６箇月定期,4753.333,28520,6,,,,
 00006,1,001,１箇月定期,7920,7920,1,,,,
 00006,1,003,６箇月定期,7920,47520,6,,,,
@@ -18,3 +12,9 @@
 00069,1,006,６箇月,7181.666,43090,6,,,,
 00070,1,003,６箇月定期,6426.666,38560,6,,,,
 00071,1,003,６箇月定期,6879,6879,1,,,,
+00001,2,001,テスト,15000,0,0,0,0,0,
+00001,3,001,プリペイドカード,20000,20000,,,,,
+00002,2,001,テスト,15000,0,0,0,0,0,
+00002,3,002,0002テスト,45000,60000,,,,,
+00003,2,002,テスト2,500,500,10,500,10,0,
+00004,3,003,0004テスト,5000,5000,,,,,

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

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)
+    If cache.Exists(code) Then
-        ' K column = value (第4列)
+        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
+    ' Check J column in the T1, T2, T3
-    Dim i As Long
     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