cache refactor

This commit is contained in:
updsv7
2026-04-22 19:43:18 +09:00
parent 1056cb1d1b
commit 1c200c6820
17 changed files with 526 additions and 607 deletions

View File

@@ -72,6 +72,10 @@ End Function
' Event Handlers
' ============================================================
Private Sub Worksheet_Change(ByVal Target As Range)
Dim HasHeaderEdit As Boolean: HasHeaderEdit = CheckHeaderEdit(Me, Target)
If HasHeaderEdit = True Then Exit Sub
Dim watchArea As Range
With Me
Set watchArea = Union( _
@@ -118,7 +122,7 @@ Private Sub Worksheet_Change(ByVal Target 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 z4Cache As Object: Set z4Cache = GetCache("Z4")
Dim todokeCde As String: todokeCde = GetCode(todoke)
If z4Cache.Exists(todokeCde) Then
Dim cellH As Range: Set cellH = Me.Cells(cellG.Row, 8)
@@ -274,7 +278,7 @@ End Sub
' Fill kukan info from M1 cache (key: kukan code, value: 7 elements)
Private Sub FillKukanFromM1(ByVal rowNum As Long, ByVal idx As Long)
Dim m1Cache As Object: Set m1Cache = GetM1Cache()
Dim m1Cache As Object: Set m1Cache = GetCache("M1")
Dim codeCol As Long: codeCol = KUKAN_CODE_COLS(idx)
Dim transportCol As Long: transportCol = KUKAN_TRANSPORT_COLS(idx)
@@ -309,7 +313,7 @@ End Sub
' triggered by c clomun cshainno input
Private Sub CreateAddress1Dropdown(ByVal rowNum As Long)
Dim o1Cache As Object: Set o1Cache = GetO1Cache()
Dim o1Cache As Object: Set o1Cache = GetCache("O1")
Dim empNo As String
empNo = Trim(Me.Cells(rowNum, 3).Value)
@@ -345,7 +349,7 @@ End Sub
' triggered by address1 select O1 cache
Private Sub CreateAddress2Dropdown(ByVal rowNum As Long)
Dim o1Cache As Object: Set o1Cache = GetO1Cache()
Dim o1Cache As Object: Set o1Cache = GetCache("O1")
Dim empNo As String
empNo = Trim(Me.Cells(rowNum, 3).Value)
@@ -399,7 +403,7 @@ 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()
Dim m1KukanDCache As Object: Set m1KukanDCache = GetCache("M1KukanDCache")
Dim transport As String: transport = GetCode(Me.Cells(rowNum, transportCol).Value)
If transport = "" Then Exit Sub
@@ -431,8 +435,8 @@ End Sub
' Create Kenshu dropdown from
' Structure: { D: { F: [G] } }
Private Sub CreateKenshuDropdown(ByVal rowNum As Long, ByVal idx As Long, ByVal kukanCode As String)
Dim kenshuList As Object: Set kenshuList = GetKenshuList()
Dim m2Cache As Object: Set m2Cache = GetM2Cache()
Dim kenshuList As Object: Set kenshuList = GetCache("kenshuList")
Dim m2Cache As Object: Set m2Cache = GetCache("M2")
Dim ticketCol As Long: ticketCol = KUKAN_TICKET_COLS(idx)
Me.Cells(rowNum, ticketCol).ClearContents
@@ -464,7 +468,7 @@ End Sub
' 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()
Dim m1KukanDCache As Object: Set m1KukanDCache = GetCache("M1KukanDCache")
Dim transport As String: transport = GetCode(Me.Cells(rowNum, transportCol).Value)
Dim stationFrom As String: stationFrom = GetCode(Me.Cells(rowNum, stationFromCol).Value)
@@ -499,7 +503,7 @@ End Sub
' Find kukan code by transport + station_from + station_to (reverse lookup)
Private Function FindKukanCodeByStation(ByVal rowNum As Long, ByVal transportCol As Long, ByVal stationFromCol As Long, ByVal stationToCol As Long) As String
Dim m1Cache As Object: Set m1Cache = GetM1Cache()
Dim m1Cache As Object: Set m1Cache = GetCache("M1")
Dim transportKbn As String: transportKbn = GetCode(Trim(Me.Cells(rowNum, transportCol).Value))
Dim stationFrom As String: stationFrom = Trim(Me.Cells(rowNum, stationFromCol).Value)
@@ -530,7 +534,7 @@ End Sub
' 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()
Dim m2Cache As Object: Set m2Cache = GetCache("M2")
Dim kukanCode As String: kukanCode = Trim(Me.Cells(rowNum, kukanCodeCol).Value)
Dim kanshuStr As String: kanshuStr = Trim(Me.Cells(rowNum, kanshuCol).Value)
@@ -634,7 +638,7 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
' validate CodeSelect
' G column [todoke Cde]
Dim ColG As String: ColG = "G"
Dim z4Cache As Object: Set z4Cache = GetZ4Cache()
Dim z4Cache As Object: Set z4Cache = GetCache("Z4")
Dim todokeCde As String: todokeCde = GetCode(Trim(Me.Cells(rowNum, ColG).Value))
If Not z4Cache.Exists(todokeCde) Then
Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E001", ColG & rowNum)
@@ -643,7 +647,7 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
End If
' I column [address1 J column address2]
Dim o1Cache As Object: Set o1Cache = GetO1Cache()
Dim o1Cache As Object: Set o1Cache = GetCache("O1")
Dim ColI As String: ColI = "I"
Dim ColJ As String: ColJ = "J"
Dim address1 As String: address1 = Trim(Me.Cells(rowNum, ColI).Value)
@@ -687,7 +691,7 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
' validate CodeSelect
' M column [oufuku]
Dim ColM As String: ColM = "M"
Dim oufukuList As Object: Set oufukuList = GetOufukuList()
Dim oufukuList As Object: Set oufukuList = GetCache("oufukuList")
Dim oufukuCde As String: oufukuCde = GetCode(Trim(Me.Cells(rowNum, ColM).Value))
If Not oufukuList.Exists(oufukuCde) Then
Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E001", ColM & rowNum)
@@ -698,7 +702,7 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
' validate CodeSelect
' N column [koutai]
Dim ColN As String: ColN = "N"
Dim koutaiList As Object: Set koutaiList = GetKoutaiList()
Dim koutaiList As Object: Set koutaiList = GetCache("koutaiList")
Dim koutaiCde As String: koutaiCde = GetCode(Trim(Me.Cells(rowNum, ColN).Value))
If Not koutaiList.Exists(koutaiCde) Then
Me.Cells(rowNum, errorCol).Value = ColN & " column is invalid"
@@ -707,8 +711,8 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
End If
' validate KUKAN_CODE_COLS (S, Z, AG, AN) and related columns
Dim m1Cache As Object: Set m1Cache = GetM1Cache()
Dim m2Cache As Object: Set m2Cache = GetM2Cache()
Dim m1Cache As Object: Set m1Cache = GetCache("M1")
Dim m2Cache As Object: Set m2Cache = GetCache("M2")
Dim kukanCols As Variant
kukanCols = Array(KUKAN_TRANSPORT_COLS, KUKAN_STATION_COLS, KUKAN_ARRIVAL_COLS, KUKAN_TICKET_COLS, KUKAN_CODE2_COLS, KUKAN_START_DAY_COLS)

View File

@@ -9,7 +9,7 @@
' Create dropdown for L column
Private Sub CreateEnumDropdown(ByVal rowNum As Long)
Dim tokubetuList As Object: Set tokubetuList = GetTokubetu()
Dim tokubetuList As Object: Set tokubetuList = GetCache("tokubetuList")
' Build dropdown list from tokubetuList
Dim dropdownList As String
dropdownList = ""
@@ -36,6 +36,9 @@ End Sub
'
Private Sub Worksheet_Change(ByVal Target As Range)
Dim HasHeaderEdit As Boolean: HasHeaderEdit = CheckHeaderEdit(Me, Target)
If HasHeaderEdit = True Then Exit Sub
' === Column C changes: Create L column dropdown ===
If Target.Column = 3 And Target.Row >= 7 Then
Dim cell As Range
@@ -51,7 +54,7 @@ Private Sub Worksheet_Change(ByVal Target As Range)
' === Column D changes: Fill E column ===
If Target.Column = 4 And Target.Row >= 7 Then
Dim z1Cache As Object: Set z1Cache = GetZ1Cache()
Dim z1Cache As Object: Set z1Cache = GetCache("Z1")
Dim cellD As Range
For Each cellD In Target
@@ -115,7 +118,7 @@ Private Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
End If
' Check D and E column in the cache
Dim z1Cache As Object: Set z1Cache = GetZ1Cache()
Dim z1Cache As Object: Set z1Cache = GetCache("Z1")
Dim dValue As String: dValue = Trim(ws.Range("D" & rowNum).Value)
Dim eValue As String: eValue = Trim(ws.Range("E" & rowNum).Value)
@@ -143,7 +146,7 @@ Private Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
End If
' Check L column in the tokubetuList
Dim tokubetuList As Object: Set tokubetuList = GetTokubetu()
Dim tokubetuList As Object: Set tokubetuList = GetCache("tokubetuList")
Dim lValue As String: lValue = Trim(ws.Range("L" & rowNum).Value)
If Not tokubetuList.Exists(lValue) Then
ws.Cells(rowNum, errorCol).Value = "L column does not exist."
@@ -152,7 +155,7 @@ Private Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
End If
' Check if M2 uses this M1 kukan code
Dim m2Cache As Object: Set m2Cache = GetM2Cache()
Dim m2Cache As Object: Set m2Cache = GetCache("M2")
If Not m2Cache.Exists(cValue) Then
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("W001", cValue)
ws.Range("C" & rowNum).Interior.Color = RGB(255, 128, 0)

View File

@@ -8,6 +8,11 @@
' - Validate
' ============================================================
Private Sub Worksheet_Change(ByVal Target As Range)
Dim HasHeaderEdit As Boolean: HasHeaderEdit = CheckHeaderEdit(Me, Target)
If HasHeaderEdit = True Then Exit Sub
If Target.EntireRow.Address = Target.Address Then Exit Sub
Dim watchArea As Range
With Me
Set watchArea = Union( _
@@ -29,6 +34,7 @@ Private Sub Worksheet_Change(ByVal Target As Range)
For Each cell In Target
If Trim(cell.Value) = "" Then
Call ClearRowData(Me, cell.Row)
GoTo Finally
Else
Call FillFromM1(cell.Row)
End If
@@ -95,11 +101,11 @@ Private Sub FillKFromJ(ByVal rowNum As Long)
Dim cache As Object
Select Case iValue
Case "1"
Set cache = GetT1Cache()
Set cache = GetCache("T1")
Case "2"
Set cache = GetT2Cache()
Set cache = GetCache("T2")
Case "3"
Set cache = GetT3Cache()
Set cache = GetCache("T3")
Case Else
Exit Sub
End Select
@@ -145,14 +151,14 @@ Private Sub CreateJDropdown(ByVal rowNum As Long)
Dim cache As Object
Select Case iValue
Case "1"
Set cache = GetT1Cache()
Set cache = GetCache("T1")
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()
Set cache = GetCache("T2")
Case "3"
Set cache = GetT3Cache()
Set cache = GetCache("T3")
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)
@@ -187,7 +193,7 @@ End Sub
Private Sub FillFromM1(ByVal rowNum As Long)
Set ws = Me
Dim m1Cache As Object: Set m1Cache = GetM1Cache()
Dim m1Cache As Object: Set m1Cache = GetCache("M1")
Dim cValue As String: cValue = Trim(ws.Range("C" & rowNum).Value)
' Fill D, E, F, G, H columns from M1 cache
@@ -223,9 +229,10 @@ End Sub
Private Sub ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long)
' Clear from D column onwards
ws.Range(ws.Cells(rowNum, 4), ws.Cells(rowNum, 15)).ClearContents
ws.Cells(rowNum, 6).Validation.Delete
ws.Cells(rowNum, 19).ClearContents ' Q column error info
ws.Range(ws.Cells(rowNum, "D"), ws.Cells(rowNum, "R")).ClearContents
ws.Range(ws.Cells(rowNum, "C"), ws.Cells(rowNum, "R")).Interior.Color = vbWhite
ws.Cells(rowNum, "J").Validation.Delete
ws.Cells(rowNum, "S").ClearContents
End Sub
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
@@ -241,19 +248,19 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
clearRange.Interior.Color = vbWhite
' Check C column in the cache
Dim m1Cache As Object: Set m1Cache = GetM1Cache()
Dim m1Cache As Object: Set m1Cache = GetCache("M1")
' C column check
checkResult = CheckRequired(ws, rowNum, 3, errorCol)
If checkResult = False Then Exit Sub
Dim cValue As String: cValue = Trim(ws.Range("C" & rowNum).Value)
If Not m1Cache.Exists(cValue) Then
If Not m1Cache.Exists(cValue) Then
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E004", "C" & rowNum)
ws.Range("C" & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
' Check column required
Dim colLetter As Variant
For Each colLetter In Array("I", "J", "K", "L", "M")
@@ -277,7 +284,7 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
Next col
' Check I column in the kenshuKbn
Dim kenshuList As Object: Set kenshuList = GetKenshuList()
Dim kenshuList As Object: Set kenshuList = GetCache("kenshuList")
Dim kenshuKbn As String: kenshuKbn = Trim(ws.Range("I" & rowNum).Value)
If Not kenshuList.Exists(kenshuKbn) Then
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E012", "I" & rowNum)
@@ -299,7 +306,7 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
Dim equaledCols As Variant
Dim emptyCols As Variant
If kenshuKbn = "1" Then
Set cache = GetT1Cache()
Set cache = GetCache("T1")
' must input
equaledCols = Array("K")
requiredCols = Array("N")
@@ -307,7 +314,7 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
End If
If kenshuKbn = "2" Then
Set cache = GetT2Cache()
Set cache = GetCache("T2")
' must input
equaledCols = Array("K", "L", "M", "N", "O", "P", "Q")
requiredCols = Array("N", "O", "P", "Q")
@@ -315,7 +322,7 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
End If
If kenshuKbn = "3" Then
Set cache = GetT3Cache()
Set cache = GetCache("T3")
' must input
equaledCols = Array("K", "L", "M")
requiredCols = Array()
@@ -381,6 +388,13 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
End Sub
Sub ImportCSVAndTriggerChange(ws As Worksheet)
' TODO
Public Sub ImportCSVAndTriggerChange(ws As Worksheet, ByVal lastDataRow As Long)
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
Dim startRow As Long: startRow = sheetConf("StartRow")
Dim i As Long
For i = startRow To lastDataRow
Call FillFromM1(i)
Next i
End Sub

View File

@@ -39,9 +39,6 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
If checkResult = False Then Exit Sub
' E column check
checkResult = CheckRequired(ws, rowNum, 5, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckVarcharOver(ws, rowNum, 5, 80, errorCol)
If checkResult = False Then Exit Sub

View File

@@ -39,9 +39,6 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
If checkResult = False Then Exit Sub
' E column check
checkResult = CheckRequired(ws, rowNum, 5, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckVarcharOver(ws, rowNum, 5, 80, errorCol)
If checkResult = False Then Exit Sub

View File

@@ -39,9 +39,6 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
If checkResult = False Then Exit Sub
' E column check
checkResult = CheckRequired(ws, rowNum, 5, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckVarcharOver(ws, rowNum, 5, 80, errorCol)
If checkResult = False Then Exit Sub

View File

@@ -41,9 +41,6 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
If checkResult = False Then Exit Sub
' E column check
checkResult = CheckRequired(ws, rowNum, 5, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckVarcharOver(ws, rowNum, 5, 80, errorCol)
If checkResult = False Then Exit Sub

View File

@@ -39,9 +39,6 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
If checkResult = False Then Exit Sub
' E column check
checkResult = CheckRequired(ws, rowNum, 5, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckVarcharOver(ws, rowNum, 5, 80, errorCol)
If checkResult = False Then Exit Sub

View File

@@ -38,9 +38,6 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
If checkResult = False Then Exit Sub
' E column check
checkResult = CheckRequired(ws, rowNum, 5, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckVarcharOver(ws, rowNum, 5, 80, errorCol)
If checkResult = False Then Exit Sub

View File

@@ -38,9 +38,6 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
If checkResult = False Then Exit Sub
' E column check
checkResult = CheckRequired(ws, rowNum, 5, errorCol)
If checkResult = False Then Exit Sub
checkResult = CheckVarcharOver(ws, rowNum, 5, 80, errorCol)
If checkResult = False Then Exit Sub