M2 update

This commit is contained in:
simple321vip
2026-04-22 00:00:00 +08:00
parent 5bb92f89c4
commit 1056cb1d1b
4 changed files with 166 additions and 21 deletions

View File

@@ -1,12 +1,6 @@
利用区間コード,券種,コード,名称,1箇月運賃/販売額,定期額/券1(額)/利用額,定期支給期間/券1(枚)/特別料金,特別料金/券2(額),券2(枚),端数(額),特別料金 利用区間コード,券種,コード,名称,1箇月運賃/販売額,定期額/券1(額)/利用額,定期支給期間/券1(枚)/特別料金,特別料金/券2(額),券2(枚),端数(額),特別料金
00001,1,003,6箇月定期,7920,47520,6,,,, 00001,1,003,6箇月定期,7920,47520,6,,,,
00001,2,001,テスト,15000,0,0,0,0,0,
00001,3,001,プリペイドカード,20000,20000,,,,,
00002,1,003,6箇月定期,1451.833,8711,6,,,, 00002,1,003,6箇月定期,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,6箇月定期,4753.333,28520,6,,,, 00005,1,003,6箇月定期,4753.333,28520,6,,,,
00006,1,001,1箇月定期,7920,7920,1,,,, 00006,1,001,1箇月定期,7920,7920,1,,,,
00006,1,003,6箇月定期,7920,47520,6,,,, 00006,1,003,6箇月定期,7920,47520,6,,,,
@@ -17,4 +11,10 @@
00068,1,003,6箇月定期,52800,316800,6,,,, 00068,1,003,6箇月定期,52800,316800,6,,,,
00069,1,006,6箇月,7181.666,43090,6,,,, 00069,1,006,6箇月,7181.666,43090,6,,,,
00070,1,003,6箇月定期,6426.666,38560,6,,,, 00070,1,003,6箇月定期,6426.666,38560,6,,,,
00071,1,003,6箇月定期,6879,6879,1,,,, 00071,1,003,6箇月定期,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,,,,,
1 利用区間コード 券種 コード 名称 1箇月運賃/販売額 定期額/券1(額)/利用額 定期支給期間/券1(枚)/特別料金 特別料金/券2(額) 券2(枚) 端数(額) 特別料金
2 00001 1 003 6箇月定期 7920 47520 6
00001 2 001 テスト 15000 0 0 0 0 0
00001 3 001 プリペイドカード 20000 20000
3 00002 1 003 6箇月定期 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
4 00005 1 003 6箇月定期 4753.333 28520 6
5 00006 1 001 1箇月定期 7920 7920 1
6 00006 1 003 6箇月定期 7920 47520 6
11 00068 1 003 6箇月定期 52800 316800 6
12 00069 1 006 6箇月 7181.666 43090 6
13 00070 1 003 6箇月定期 6426.666 38560 6
14 00071 1 003 6箇月定期 6879 6879 1
15 00001 2 001 テスト 15000 0 0 0 0 0
16 00001 3 001 プリペイドカード 20000 20000
17 00002 2 001 テスト 15000 0 0 0 0 0
18 00002 3 002 0002テスト 45000 60000
19 00003 2 002 テスト2 500 500 10 500 10 0
20 00004 3 003 0004テスト 5000 5000

View File

@@ -285,7 +285,7 @@ Private Sub RefreshT3Cache()
Set t3Cache = Nothing Set t3Cache = Nothing
On Error GoTo RefreshError 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 On Error GoTo 0
If t3Cache Is Nothing Or t3Cache.Count = 0 Then If t3Cache Is Nothing Or t3Cache.Count = 0 Then

View File

@@ -8,8 +8,23 @@
' - Validate ' - Validate
' ============================================================ ' ============================================================
Private Sub Worksheet_Change(ByVal Target As Range) 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 === ' === 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 Dim cell As Range
For Each cell In Target For Each cell In Target
If Trim(cell.Value) = "" Then If Trim(cell.Value) = "" Then
@@ -21,25 +36,55 @@ Private Sub Worksheet_Change(ByVal Target As Range)
End If End If
' === Create J dropdown when I column changes === ' === 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 Dim cellI As Range
For Each cellI In Target 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) Call CreateJDropdown(cellI.Row)
Next Next
End If End If
' === Fill K column when J column changes === ' === 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 Dim cellJ As Range
For Each cellJ In Target For Each cellJ In Target
Call FillKFromJ(cellJ.Row) Call FillKFromJ(cellJ.Row)
Next Next
End If 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 End Sub
Private Sub FillKFromJ(ByVal rowNum As Long) Private Sub FillKFromJ(ByVal rowNum As Long)
Dim iValue As String: iValue = Trim(Me.Range("I" & rowNum).Value) Dim iValue As String: iValue = Trim(Me.Range("I" & rowNum).Value)
Dim jValue As String: jValue = Trim(Me.Range("J" & rowNum).Value) Dim jValue As String: jValue = Trim(Me.Range("J" & rowNum).Value)
Dim code As String: code = GetCode(jValue)
If jValue = "" Then If jValue = "" Then
Me.Range("K" & rowNum).ClearContents Me.Range("K" & rowNum).ClearContents
@@ -62,13 +107,29 @@ Private Sub FillKFromJ(ByVal rowNum As Long)
If cache Is Nothing Then Exit Sub If cache Is Nothing Then Exit Sub
' Check if J value exists in cache ' 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)) Me.Range("K" & rowNum).Value = Trim(cacheVal(0))
End If 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 End Sub
@@ -85,10 +146,17 @@ Private Sub CreateJDropdown(ByVal rowNum As Long)
Select Case iValue Select Case iValue
Case "1" Case "1"
Set cache = GetT1Cache() 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" Case "2"
Set cache = GetT2Cache() Set cache = GetT2Cache()
Case "3" Case "3"
Set cache = GetT3Cache() 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 Case Else
Exit Sub Exit Sub
End Select End Select
@@ -99,10 +167,11 @@ Private Sub CreateJDropdown(ByVal rowNum As Long)
Dim dropdownList As String: dropdownList = "" Dim dropdownList As String: dropdownList = ""
Dim key As Variant Dim key As Variant
For Each key In cache.Keys For Each key In cache.Keys
Dim displayText As String: displayText = MakeSelect(key, cache(key)(0))
If dropdownList = "" Then If dropdownList = "" Then
dropdownList = key dropdownList = displayText
Else Else
dropdownList = dropdownList & "," & key dropdownList = dropdownList & "," & displayText
End If End If
Next key Next key
@@ -187,7 +256,7 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
' Check column required ' Check column required
Dim colLetter As Variant 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 If Trim(ws.Range(colLetter & rowNum).Value) = "" Then
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E002", colLetter & rowNum) ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E002", colLetter & rowNum)
ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0) 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 Exit Sub
End If 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 code As String: code = Trim(ws.Range("J" & rowNum).Value)
Dim name As String: name = Trim(ws.Range("K" & 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 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 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) 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 End Sub
Sub ImportCSVAndTriggerChange(ws As Worksheet) Sub ImportCSVAndTriggerChange(ws As Worksheet)
' TODO
End Sub End Sub