updsv7/vba
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

20260515指摘対応6

Browse Source
This commit is contained in:
guanxiangwei
2026-05-20 18:46:15 +09:00
parent b25db7d99c
commit 5b4ffe87aa
18 changed files with 259 additions and 185 deletions
Download Patch File Download Diff File Expand all files Collapse all files

182
src/sh/tuk/module/Common_Button.bas
View File

@@ -1,11 +1,24 @@
Attribute VB_Name = "Common_Button"
Option Explicit
' --- Public Variables ---
Public lastErrorMsg As String
' ============================================================
' Module Name: Common_Button
' Module Desc: Common_Button
' Module Desc: Common Button handlers with centralized error handling
' Module Methods:
' - CSV_Import_Button
' - Validation_Button
' - CSV_Export_Button
' - Sort_Button
' - Filter_Button
' - Fit_Button
' - RefreshCache_Button
' ============================================================
' --- Public Button Functions ---
Sub CSV_Import_Button()
DO_CSV_Import ActiveSheet
End Sub
@@ -54,7 +67,6 @@ Sub RefreshCache_Button()
Call RefreshMasterCache()
Debug.Print "3. Determine which cache sheets to refresh based on ActiveSheet"
Dim refSheets As Variant
If activeSheetName = "C1" Then
' first is M1
Call ValidateKukanCache("M1")
@@ -77,43 +89,22 @@ Sub RefreshCache_Button()
ErrorHandler:
HandleError "RefreshCache_Button"
If exitMsg <> "" Then
MsgBox "RefreshCache_Button: " & exitMsg, vbExclamation
Else
MsgBox "RefreshCache_Button: " & Err.Description, vbExclamation
End If
End Sub
Private Sub ValidateKukanCache(ByVal sheetName As String)
On Error GoTo ErrorHandler
Dim exitMsg As String
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets(CStr(sheetName))
Dim result As Long: result = RunValidationSilent(ws)
If result = 0 Then
exitMsg = sheetName & " sheet has no data."
GoTo ErrorHandler
Err.Raise ERR_CACHE_EMPTY, "ValidateKukanCache", sheetName & " sheet has no data."
End If
If result < 0 Then
exitMsg = "Can't refresh " & sheetName & " cache. Validation error occurs."
GoTo ErrorHandler
End If
Exit Sub
ErrorHandler:
If exitMsg <> "" Then
MsgBox "ValidateKukanCache: " & exitMsg, vbExclamation
Else
MsgBox "ValidateKukanCache: " & Err.Description, vbExclamation
If result = -1 Then
Err.Raise ERR_VALIDATION_FAILED, "ValidateKukanCache", "Validation error in " & sheetName & " sheet."
End If
End Sub
Private Sub UpdateByMaster(ByVal sheetName As String)
On Error GoTo ErrorHandler
Dim exitMsg As String
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets(CStr(sheetName))
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
@@ -121,19 +112,13 @@ Private Sub UpdateByMaster(ByVal sheetName As String)
Dim startRow As Long: startRow = sheetConf("StartRow")
Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(ws)
Application.Run sheetName & ".Refresh", ws, startRow, lastDataRow
Exit Sub
ErrorHandler:
If exitMsg <> "" Then
MsgBox "UpdateByMaster: " & exitMsg, vbExclamation
Else
MsgBox "UpdateByMaster: " & Err.Description, vbExclamation
End If
End Sub
' ============================================================
' CSV Import with error handler
' ============================================================
Private Sub DO_CSV_Import(ws As Excel.Worksheet)
On Error GoTo ImportError
On Error GoTo ErrorHandler
' Step 1: get csv encoding
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
@@ -147,71 +132,61 @@ Private Sub DO_CSV_Import(ws As Excel.Worksheet)
' Step 3: Read CSV and return 2D array
Dim csvData As Variant: csvData = ReadCSVAs2DArrayStrict(filePath, expectedColumnCount, cfg("CSV_Encoding"), cfg("HasHeader"))
If Not IsArray(csvData) Then
MsgBox "No valid data returned from CSV.", vbExclamation
GoTo FinallyExit
If Not IsArray(csvData) Or UBound(csvData, 1) < 1 Then
Err.Raise ERR_FILE_EMPTY, "DO_CSV_Import", "No data in CSV."
End If
If UBound(csvData, 1) < 1 Then
MsgBox "No data in CSV.", vbExclamation
GoTo FinallyExit
End If
' === Step 3:Clear all data rows before import ===
' === Step 4: Clear all data rows before import ===
Application.ScreenUpdating = False
Application.EnableEvents = False
Call ClearDataRows(ws)
' === Step 4: Write CSV data to worksheet ===
' === Step 5: Write CSV data to worksheet ===
Dim colLetters As Variant: colLetters = cfg("HeaderColumns")
Dim writeRow As Long: writeRow = cfg("StartRow")
Dim i As Long
' loop row
For i = LBound(csvData, 1) To UBound(csvData, 1)
Dim j As Long
' loop column
For j = 0 To expectedColumnCount - 1
ws.Cells(writeRow, ws.Range(colLetters(j) & "1").Column).Value = CleanCSVField(CStr(csvData(i, j + 1)))
Next j
writeRow = writeRow + 1
Next i
' === Step 5: Trigger sheet-specific import handler ===
If ProcedureExists(ws.CodeName, "ImportCSVAndTriggerChange") Then
Call Application.Run(ws.CodeName & ".ImportCSVAndTriggerChange", ws, writeRow)
End If
MsgBox writeRow - cfg("StartRow") & " rows imported.", vbInformation
GoTo FinallyExit
ImportError:
MsgBox "CSV import failed: " & Err.Description, vbExclamation
ErrorHandler:
HandleError "DO_CSV_Import"
GoTo FinallyExit
FinallyExit:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
'
' ============================================================
' Do_Validation with HandleError
' ============================================================
Private Sub Do_Validation(ws As Excel.Worksheet)
On Error GoTo ErrorHandler
Dim exitMsg As String
Dim result As Long: result = RunValidationSilent(ws)
If result = -1 Then
exitMsg = "Validation has errors."
GoTo ErrorHandler
ElseIf result = 0 Then
exitMsg = "No data to validate."
GoTo ErrorHandler
Else
Err.Raise ERR_VALIDATION_FAILED, "Do_Validation", "Validation has errors."
End If
If result = 0 Then
Err.Raise ERR_CACHE_EMPTY, "Do_Validation", "No data to validate."
End If
If ws.CodeName <> "C1" Then
RefreshCache(ws.CodeName)
WriteCachesSheet(ws.CodeName)
End If
MsgBox "Validation complete. Success: " & result, vbInformation
End If
' step2. ValidateWarn for M1 sheet
If ws.CodeName = "M1" Then
@@ -220,33 +195,27 @@ Private Sub Do_Validation(ws As Excel.Worksheet)
End If
Do_Fit ws
Exit Sub
ErrorHandler:
HandleError "Do_Validation"
' If exitMsg <> "" Then
' MsgBox "Do_Validation: " & exitMsg, vbExclamation
' Else
' MsgBox "Do_Validation: " & Err.Description, vbExclamation
' End If
End Sub
'
' ============================================================
' CSV Export with HandleError
' ============================================================
Private Sub DO_CSV_Export(ws As Excel.Worksheet)
On Error GoTo ExportError
On Error GoTo ErrorHandler
' === Step 1: Validate all rows before export ===
Dim result As Long: result = RunValidationSilent(ws)
If result = 0 Then
MsgBox "No data rows to output.", vbExclamation
Exit Sub
Err.Raise ERR_CACHE_EMPTY, "DO_CSV_Export", "No data rows to output."
End If
If result < 0 Then
MsgBox "Validation failed. Export aborted.", vbCritical
Exit Sub
Err.Raise ERR_VALIDATION_FAILED, "DO_CSV_Export", "Validation failed. Export aborted."
End If
' === Step 2: Select save path ===
@@ -269,7 +238,6 @@ Private Sub DO_CSV_Export(ws As Excel.Worksheet)
Dim dataRow As Long: dataRow = 1
Dim outputArr As Variant
' when has header + 1
If hasHeader Then
ReDim outputArr(1 To rowCount + 1, 1 To expectedColumnCount)
Else
@@ -292,22 +260,23 @@ Private Sub DO_CSV_Export(ws As Excel.Worksheet)
Dim r As Long
For r = startRow To lastDataRow
For colIdx = 0 To expectedColumnCount - 1
outputArr(dataRow, colIdx + 1) = CleanCSVField(ws.Cells(r, Columns(colLetters(colIdx)).Column).Value)
outputArr(dataRow, colIdx + 1) = CleanCSVField(ws.Cells(r, Columns(colLetters(colIdx))).Column).Value)
Next colIdx
dataRow = dataRow + 1
Next r
On Error GoTo ExportError
Call WriteCSVFromArray(savePath, outputArr, sheetConf("CSV_Encoding"), sheetConf("AlwaysQuote"))
On Error GoTo 0
MsgBox "CSV export completed. Total data rows: " & rowCount, vbInformation
Exit Sub
ExportError:
MsgBox "CSV export failed: " & Err.Description, vbExclamation
ErrorHandler:
HandleError "DO_CSV_Export"
End Sub
' ============================================================
' Do_Sort with HandleError
' ============================================================
Private Sub Do_Sort(ws As Excel.Worksheet)
On Error GoTo ErrorHandler
@@ -320,8 +289,7 @@ Private Sub Do_Sort(ws As Excel.Worksheet)
Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(ws)
If lastDataRow < startRow Then
MsgBox "No data to sort.", vbExclamation
Exit Sub
Err.Raise ERR_CACHE_EMPTY, "Do_Sort", "No data to sort."
End If
Dim sortRange As Range: Set sortRange = ws.Range(ws.Cells(startRow, ws.Range(startCol & "1").Column), ws.Cells(lastDataRow, ws.Range(endCol & "1").Column))
@@ -332,9 +300,12 @@ Private Sub Do_Sort(ws As Excel.Worksheet)
Exit Sub
ErrorHandler:
MsgBox "Error: " & Err.Description, vbCritical
HandleError "Do_Sort"
End Sub
' ============================================================
' Do_Filter with HandleError
' ============================================================
Private Sub Do_Filter(ws As Excel.Worksheet)
On Error GoTo ErrorHandler
@@ -357,16 +328,19 @@ Private Sub Do_Filter(ws As Excel.Worksheet)
Exit Sub
ErrorHandler:
MsgBox "Error: " & Err.Description, vbCritical
HandleError "Do_Filter"
End Sub
' ============================================================
' Do_Fit with HandleError
' ============================================================
Private Sub Do_Fit(ws As Excel.Worksheet)
On Error GoTo ErrorHandler
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
' 2026-05-15 adjust width function contains error column
' adjust width function contains error column
Dim startCol As String: startCol = sheetConf("ErrorCol")
Dim endCol As String: endCol = sheetConf("EndCol")
@@ -374,14 +348,16 @@ Private Sub Do_Fit(ws As Excel.Worksheet)
Exit Sub
ErrorHandler:
MsgBox "Error: " & Err.Description, vbCritical
HandleError "Do_Fit"
End Sub
' ============================================================
' RunValidationSilent
' Positive number = success (number of rows with no errors)
' 0 = no data
' -1 = has errors
' -2 = runtime error
' Returns:
' - Positive number = success (number of rows validated)
' - 0 = no data
' - -1 = has errors
' ============================================================
Public Function RunValidationSilent(ws As Worksheet) As Long
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
@@ -399,8 +375,12 @@ Public Function RunValidationSilent(ws As Worksheet) As Long
Dim r As Long
Dim hasError As Boolean: hasError = False
For r = startRow To lastDataRow
lastErrorMsg = ""
Application.Run validate, ws, r, lastDataRow
Dim errorMessage As String : errorMessage = Trim(ws.Cells(r, errorCol).Value)
If lastErrorMsg <> "" Then
Err.Raise ERR_VALIDATION_FAILED, "RunValidationSilent", lastErrorMsg
End If
Dim errorMessage As String: errorMessage = Trim(ws.Cells(r, errorCol).Value)
Dim errorCode As String: errorCode = GetCode(errorMessage)
If errorCode <> "W001" And errorCode <> "" Then
hasError = True
@@ -416,12 +396,14 @@ Public Function RunValidationSilent(ws As Worksheet) As Long
Exit Function
End Function
Public Sub HandleError(sourceProcedure As String)
Dim msg As String
' ============================================================
' Error Handlers
' ============================================================
' Main error handler - centralized error processing
Public Sub HandleError(Optional ByVal sourceProcedure As String = "")
Dim shortCode As String: shortCode = Right("0000" & CStr(Err.Number - vbObjectError), 4)
MsgBox "[ERROR] " & shortCode & " : " & Err.Description, vbExclamation
Select Case Err.Number
Case ERR_CACHE_EMPTY
msg = Err.Description
MsgBox msg, vbExclamation
End Select
End Sub

30
src/sh/tuk/module/Common_Constants.bas
View File

@@ -2,9 +2,35 @@ Attribute VB_Name = "Common_Constants"
Option Explicit
' ============================================================
' Module Name: Common_Constants
' Module Desc: Common_Constants
' Module Methods:
' Module Desc: Common Error Constants
' Module Error Codes:
' - Cache errors (1001-1003)
' - File/CSV errors (5001-5009)
' - Config errors (1004-1006)
' - Validation errors (2001+)
' ============================================================
' --- Cache errors ---
Public Const ERR_CACHE_NOT_FOUND As Long = vbObjectError + 1001
Public Const ERR_CACHE_EMPTY As Long = vbObjectError + 1002
Public Const ERR_VALIDATION_FAILED As Long = vbObjectError + 1003
' --- File/CSV errors ---
Public Const ERR_FILE_INVALID_ARRAY As Long = vbObjectError + 5001
Public Const ERR_FILE_NOT_2D As Long = vbObjectError + 5002
Public Const ERR_FILE_NOT_FOUND As Long = vbObjectError + 5003
Public Const ERR_FILE_EMPTY As Long = vbObjectError + 5004
Public Const ERR_FILE_NO_DATA As Long = vbObjectError + 5005
Public Const ERR_FILE_COLUMN_MISMATCH As Long = vbObjectError + 5006
Public Const ERR_FILE_INVALID_PARAM As Long = vbObjectError + 5007
Public Const ERR_FILE_WRITE_FAILED As Long = vbObjectError + 5008
Public Const ERR_FILE_INVALID_DATA As Long = vbObjectError + 5009
' --- Config/Sheet errors ---
Public Const ERR_CONFIG_NOT_FOUND As Long = vbObjectError + 1004
Public Const ERR_CONFIG_INVALID As Long = vbObjectError + 1005
Public Const ERR_CONFIG_EMPTY_PARAM As Long = vbObjectError + 1006
Public Const ERR_SHEET_MISSING As Long = vbObjectError + 1007
' --- Validation errors ---
Public Const ERR_VALIDATION As Long = vbObjectError + 2001

27
src/sh/tuk/module/Common_File_Utils.bas
View File

@@ -36,15 +36,13 @@ Sub WriteCSVFromArray( _
)
' === Input validation ===
If Not IsArray(data) Then
Err.Raise 513, , "Input 'data' must be an array."
Err.Raise ERR_FILE_INVALID_ARRAY, "WriteCSVFromArray", "Input 'data' must be an array."
End If
Dim numDims As Long
On Error Resume Next
numDims = ArrayDimensions(data)
On Error GoTo 0
' === Check if 2D array ===
Dim numDims As Long: numDims = ArrayDimensions(data)
If numDims <> 2 Then
Err.Raise 514, , "Input array must be 2-dimensional."
Err.Raise ERR_FILE_NOT_2D, "WriteCSVFromArray", "Input array must be 2-dimensional."
End If
Dim rows As Long, cols As Long
@@ -110,13 +108,12 @@ End Sub
' Helper function: safely convert any Variant to a string
Private Function SafeToString(ByVal v As Variant) As String
On Error Resume Next
If IsNull(v) Or IsEmpty(v) Then
SafeToString = ""
Else
SafeToString = CStr(v)
Exit Function
End If
On Error GoTo 0
SafeToString = CStr(v)
End Function
' Helper function: get the number of dimensions of an array (1, 2, ...)
@@ -188,11 +185,11 @@ Function ReadCSVAs2DArrayStrict( _
' === validate expectedColumnCount ===
If expectedColumnCount <= 0 Then
Err.Raise 5001, , "expectedColumnCount must be >= 1."
Err.Raise ERR_FILE_INVALID_PARAM, "ReadCSVAs2DArrayStrict", "expectedColumnCount must be >= 1."
End If
If Dir(filePath) = "" Then
Err.Raise 5002, , "File not found: " & filePath
Err.Raise ERR_FILE_NOT_FOUND, "ReadCSVAs2DArrayStrict", "File not found: " & filePath
End If
' === read csv file ===
@@ -218,12 +215,12 @@ Function ReadCSVAs2DArrayStrict( _
' === validate empty ===
If lines.Count = 0 Then
Err.Raise 5003, , "CSV file is empty."
Err.Raise ERR_FILE_EMPTY, "ReadCSVAs2DArrayStrict", "CSV file is empty."
End If
If lines.Count = 1 Then
If hasHeader Then
Err.Raise 5005, , "CSV file data is empty."
Err.Raise ERR_FILE_NO_DATA, "ReadCSVAs2DArrayStrict", "CSV file data is empty."
End If
End If
@@ -236,7 +233,7 @@ Function ReadCSVAs2DArrayStrict( _
actualCols = UBound(rowArr) - LBound(rowArr) + 1
If actualCols <> expectedColumnCount Then
Err.Raise 5004, , "Row " & i & ": Expected " & expectedColumnCount & " columns, got " & actualCols & "."
Err.Raise ERR_FILE_COLUMN_MISMATCH, "ReadCSVAs2DArrayStrict", "Row " & i & ": Expected " & expectedColumnCount & " columns, got " & actualCols & "."
End If
Next i

31
src/sh/tuk/module/Common_Functions.bas
View File

@@ -42,7 +42,7 @@ Function GetCSVHeader(ByVal ws As Worksheet) As Variant
Exit Function
ErrorHandler:
Err.Raise 1005, "GetCSVHeader", "Invalid column letter in HeaderColumns: '" & colLetters(i) & "'"
Err.Raise ERR_CONFIG_INVALID, "GetCSVHeader", "Invalid column letter in HeaderColumns: '" & colLetters(i) & "'"
End Function
'
@@ -78,7 +78,7 @@ Function Contains(ByVal arr As Variant, ByVal value As String) As Boolean
Contains = False
End Function
' @return dict : key = keyCol，value = Array
' @return dict : key = keyCol, value = Array
' @param sheetName
' @param keyCol
' @param valueCols Array(4,5,6)
@@ -87,18 +87,21 @@ Function LoadLookup(ByVal sheetName As String, ByVal cacheName As String) As Obj
On Error GoTo ErrHandler
' --- validate ---
If Trim(sheetName) = "" Then Err.Raise 0001, "LoadLookup", "Sheet name cannot be empty."
If Trim(sheetName) = "" Then Err.Raise ERR_CONFIG_EMPTY_PARAM, "LoadLookup", "Sheet name cannot be empty."
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
If Not sheetConfDict.Exists(sheetName) Then
Err.Raise 1004, "LoadLookup", "Sheet not configured: " & sheetName
Err.Raise ERR_CONFIG_NOT_FOUND, "LoadLookup", "Sheet not configured: " & sheetName
End If
' --- obtain worksheet ---
Dim ws As Worksheet
On Error Resume Next
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets(sheetName)
If ws Is Nothing Then Err.Raise 0003, "LoadLookup", "Worksheet named '" & sheetName & "' not found."
Set ws = ThisWorkbook.Worksheets(sheetName)
On Error GoTo ErrHandler
If ws Is Nothing Then
Err.Raise ERR_SHEET_MISSING, "LoadLookup", "Worksheet '" & sheetName & "' not found."
End If
Dim sheetConf As Object: Set sheetConf = sheetConfDict(cacheName)
Dim startRow As Long: startRow = sheetConf("StartRow")
@@ -119,16 +122,20 @@ Function LoadLookup(ByVal sheetName As String, ByVal cacheName As String) As Obj
End If
Dim nValCols As Long: nValCols = UBound(valueCols) - LBound(valueCols) + 1
If nValCols = 0 Then Err.Raise 0002, "LoadLookup", "Value columns parameter is invalid."
If nValCols = 0 Then Err.Raise ERR_CONFIG_EMPTY_PARAM, "LoadLookup", "Value columns parameter is invalid."
' --- prepare col ---
Dim minCol As Long: minCol = keyCol
Dim maxCol As Long: maxCol = keyCol
Dim i As Long
For i = LBound(valueCols) To UBound(valueCols)
If Not IsNumeric(valueCols(i)) Then Exit Function
If Not IsNumeric(valueCols(i)) Then
Err.Raise ERR_CONFIG_INVALID, "LoadLookup", "Value column is not numeric at index " & i
End If
Dim colNum As Long: colNum = CLng(valueCols(i))
If colNum < 1 Then Exit Function
If colNum < 1 Then
Err.Raise ERR_CONFIG_INVALID, "LoadLookup", "Value column must be >= 1, got " & colNum
End If
If colNum < minCol Then minCol = colNum
If colNum > maxCol Then maxCol = colNum
Next i
@@ -203,12 +210,12 @@ Function GetLastDataRowInRange(ws As Worksheet) As Long
GetLastDataRowInRange = maxRow
Else
Err.Raise 1004, "GetLastDataRowInRange", "Sheet not configured: " & ws.CodeName
Err.Raise ERR_CONFIG_NOT_FOUND, "GetLastDataRowInRange", "Sheet not configured: " & ws.CodeName
End If
Exit Function
InvalidColumn:
Err.Raise 1005, "GetLastDataRowInRange", "Invalid column letter for sheet: " & ws.CodeName
Err.Raise ERR_CONFIG_INVALID, "GetLastDataRowInRange", "Invalid column letter for sheet: " & ws.CodeName
End Function
Function ClearDataRow(ByVal ws As Worksheet, ByVal startCol As Long, ByVal endCol As Long, ByVal rowRow As Long, Optional ByVal errorCol As Long = 2)
@@ -225,7 +232,7 @@ Sub ClearDataRows(ByVal ws As Worksheet)
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
'
If Not sheetConfDict.Exists(ws.CodeName) Then
Err.Raise 1004, "ClearDataRows", "Sheet not configured: " & ws.CodeName
Err.Raise ERR_CONFIG_NOT_FOUND, "ClearDataRows", "Sheet not configured: " & ws.CodeName
End If
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)

57
src/sh/tuk/module/Common_Global_Cache.bas
View File

@@ -29,7 +29,7 @@ Public Function GetCache(ByVal cacheName As String) As Object
Dim cache As Object
Set cache = GlobalCache(cacheName)
If cache.Count = 0 Then
Err.Raise 1001, "GetCache", "No cached data found for '" & cacheName & "'. Please load the cache first."
Err.Raise ERR_CACHE_NOT_FOUND, "GetCache", "No cached data found for '" & cacheName & "'. Please load the cache first."
End If
Set GetCache = cache
@@ -38,8 +38,6 @@ End Function
' before RefreshCache, should validate
Public Sub RefreshCache(ByVal cacheName As String)
On Error GoTo RefreshError
If GlobalCache Is Nothing Then InitCacheManager
If Not GlobalCache.Exists(cacheName) Then
Set GlobalCache(cacheName) = CreateObject("Scripting.Dictionary")
@@ -63,15 +61,10 @@ Public Sub RefreshCache(ByVal cacheName As String)
If Not loadedData Is Nothing Then
Set GlobalCache(cacheName) = loadedData
End If
Exit Sub
RefreshError:
Err.Raise 1001, "RefreshCache", "Failed to load " & cacheName & " lookup cache: " & Err.Description
End Sub
' Refresh M1_KukanD cache - nested dict {D: {F: [G]}}
' Structure: { 交通機関区分[D]: { 利用区間発名[F]: [利用区間着名G] } }
' Structure: { Transport type [D]: { Station from [F]: [Station to G] } }
Private Function LookupM1KukanCache()
Dim resultCache As Object
Set resultCache = CreateObject("Scripting.Dictionary")
@@ -82,17 +75,13 @@ Private Function LookupM1KukanCache()
On Error Resume Next
Set ws = ThisWorkbook.Worksheets("M1")
On Error GoTo ErrHandler
If ws Is Nothing Then
Set LookupM1KukanCache = resultCache
Exit Function
End If
' ws exists, continue
Dim sheetConf As Object: Set sheetConf = sheetConfDict("M1")
Dim startRow As Long: startRow = sheetConf("StartRow")
Dim lastRow As Long: lastRow = GetLastDataRowInRange(ws)
If lastRow < startRow Then
Set LookupM2Cache = resultCache
Set LookupM1KukanCache = resultCache
Exit Function
End If
@@ -104,13 +93,13 @@ Private Function LookupM1KukanCache()
If dValue = "" Or fValue = "" Then GoTo NextRow2
' Outer level: D column (交通機関区分)
' D column (transport type)
If Not resultCache.Exists(dValue) Then
Dim innerDict As Object: Set innerDict = CreateObject("Scripting.Dictionary")
resultCache.Add dValue, innerDict
End If
' Inner level: F column (利用区間発名) -> array of G values
' F column (station from) -> array of G values
Set innerDict = resultCache(dValue)
If Not innerDict.Exists(fValue) Then
Dim arr As Object: Set arr = CreateObject("Scripting.Dictionary")
@@ -129,12 +118,16 @@ NextRow2:
Exit Function
ErrHandler:
Err.Raise Err.Number, Err.Source, Err.Description
If Err.Number = 9 Then ' Subscript out of range (sheet not found)
Err.Raise ERR_SHEET_MISSING, "LookupM1KukanCache", "Sheet 'M1' not found."
Else
Err.Raise ERR_CACHE_NOT_FOUND, "LookupM1KukanCache", "Failed to load M1Kukan cache: " & Err.Description
End If
End Function
' ============================================================
' M2 Cache - Nested Dictionary
' Structure: { 区間コード[C]: { 券種[I]: { コード[J]: K } } }
' Structure: { Section code [C]: { Ticket type [I]: { Code [J]: K } } }
' ============================================================
Private Function LookupM2Cache() As Object
Dim resultCache As Object
@@ -146,11 +139,7 @@ Private Function LookupM2Cache() As Object
On Error Resume Next
Set ws = ThisWorkbook.Worksheets("M2")
On Error GoTo ErrHandler
If ws Is Nothing Then
Set LookupM2Cache = resultCache
Exit Function
End If
' ws exists, continue
Dim sheetConf As Object: Set sheetConf = sheetConfDict("M2")
Dim startRow As Long: startRow = sheetConf("StartRow")
@@ -195,7 +184,11 @@ NextRow:
Exit Function
ErrHandler:
Err.Raise Err.Number, Err.Source, Err.Description
If Err.Number = 9 Then
Err.Raise ERR_SHEET_MISSING, "LookupM2Cache", "Sheet 'M2' not found."
Else
Err.Raise ERR_CACHE_NOT_FOUND, "LookupM2Cache", "Failed to load M2 cache: " & Err.Description
End If
End Function
' ============================================================
@@ -205,15 +198,13 @@ Private Function LookupO1Cache() As Object
Dim resultCache As Object
Set resultCache = CreateObject("Scripting.Dictionary")
On Error GoTo ErrHandler
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Worksheets("O1")
On Error GoTo ErrHandler
If ws Is Nothing Then
Set LookupO1Cache = resultCache
Exit Function
End If
' ws exists, continue
Dim sheetConf As Object: Set sheetConf = sheetConfDict("O1")
Dim startRow As Long: startRow = sheetConf("StartRow")
@@ -261,7 +252,11 @@ NextO1:
Exit Function
ErrHandler:
Err.Raise Err.Number, Err.Source, Err.Description
If Err.Number = 9 Then
Err.Raise ERR_SHEET_MISSING, "LookupO1Cache", "Sheet 'O1' not found."
Else
Err.Raise ERR_CACHE_NOT_FOUND, "LookupO1Cache", "Failed to load O1 cache: " & Err.Description
End If
End Function
Private Sub RefreshSheetDict()

5
src/sh/tuk/sheet/C1.cls
View File

@@ -590,6 +590,7 @@ End Sub
' Validation logic
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
On Error GoTo ErrHandler
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
@@ -843,4 +844,8 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
End If
Me.Cells(rowNum, errorCol).ClearContents
Exit Sub
ErrHandler:
lastErrorMsg = Err.Description
End Sub

13
src/sh/tuk/sheet/M1.cls
View File

@@ -47,6 +47,7 @@ Private Sub Worksheet_Change(ByVal Target As Range)
End Sub
Private Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
On Error GoTo ErrHandler
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
@@ -129,15 +130,18 @@ Private Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
' Validation passed - clear error
ws.Cells(rowNum, errorCol).ClearContents
Exit Sub
ErrHandler:
lastErrorMsg = Err.Description
End Sub
' obtain z1 master data, and update column E
Private Sub Refresh(ws As Worksheet, ByVal startRow As Long, ByVal lastDataRow As Long)
Dim z1Cache As Object: Set z1Cache = GetCache("Z1")
If z1Cache Is Nothing Then Exit Sub
Application.EnableEvents = False
On Error GoTo Finally
On Error GoTo ErrorHandler
Dim r As Long
For r = startRow To lastDataRow
@@ -148,8 +152,11 @@ Private Sub Refresh(ws As Worksheet, ByVal startRow As Long, ByVal lastDataRow A
End If
Next r
Finally:
Exit Sub
ErrorHandler:
Application.EnableEvents = True
Err.Raise ERR_CACHE_NOT_FOUND, "M1.Refresh", "Failed to refresh M1: " & Err.Description
End Sub
Private Sub ValidateWarn(ws As Worksheet, ByVal lastDataRow As Long)

12
src/sh/tuk/sheet/M2.cls
View File

@@ -222,6 +222,7 @@ Private Sub ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long)
End Sub
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
On Error GoTo ErrHandler
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
@@ -362,7 +363,10 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
Next i
ws.Cells(rowNum, errorCol).ClearContents
Exit Sub
ErrHandler:
lastErrorMsg = Err.Description
End Sub
Public Sub ImportCSVAndTriggerChange(ws As Worksheet, ByVal lastDataRow As Long)
@@ -379,10 +383,9 @@ End Sub
' obtain T1/T2/T3 cache data, and update column K
Private Sub Refresh(ws As Worksheet, ByVal startRow As Long, ByVal lastDataRow As Long)
Dim kenshuList As Object: Set kenshuList = GetCache("kenshuList")
If kenshuList Is Nothing Then Exit Sub
Application.EnableEvents = False
On Error GoTo Finally
On Error GoTo ErrorHandler
Dim r As Long
For r = startRow To lastDataRow
@@ -405,6 +408,9 @@ Private Sub Refresh(ws As Worksheet, ByVal startRow As Long, ByVal lastDataRow A
NextRow:
Next r
Finally:
Exit Sub
ErrorHandler:
Application.EnableEvents = True
Err.Raise ERR_CACHE_NOT_FOUND, "M2.Refresh", "Failed to refresh M2: " & Err.Description
End Sub

6
src/sh/tuk/sheet/O1.cls
View File

@@ -14,4 +14,10 @@ Private Sub Worksheet_Change(ByVal Target As Range)
End Sub
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
On Error GoTo ErrHandler
Exit Sub
ErrHandler:
lastErrorMsg = Err.Description
End Sub

6
src/sh/tuk/sheet/O2.cls
View File

@@ -15,4 +15,10 @@ Private Sub Worksheet_Change(ByVal Target As Range)
End Sub
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
On Error GoTo ErrHandler
Exit Sub
ErrHandler:
lastErrorMsg = Err.Description
End Sub

5
src/sh/tuk/sheet/T1.cls
View File

@@ -17,6 +17,7 @@ End Sub
'
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
On Error GoTo ErrHandler
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
@@ -62,4 +63,8 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
If checkResult = False Then Exit Sub
ws.Cells(rowNum, errorCol).ClearContents
Exit Sub
ErrHandler:
lastErrorMsg = Err.Description
End Sub

5
src/sh/tuk/sheet/T2.cls
View File

@@ -17,6 +17,7 @@ End Sub
'
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
On Error GoTo ErrHandler
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
@@ -122,4 +123,8 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
If checkResult = False Then Exit Sub
ws.Cells(rowNum, errorCol).ClearContents
Exit Sub
ErrHandler:
lastErrorMsg = Err.Description
End Sub

5
src/sh/tuk/sheet/T3.cls
View File

@@ -17,6 +17,7 @@ End Sub
'
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
On Error GoTo ErrHandler
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
@@ -82,4 +83,8 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
If checkResult = False Then Exit Sub
ws.Cells(rowNum, errorCol).ClearContents
Exit Sub
ErrHandler:
lastErrorMsg = Err.Description
End Sub

5
src/sh/tuk/sheet/Z1.cls
View File

@@ -17,6 +17,7 @@ End Sub
'
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
On Error GoTo ErrHandler
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
@@ -72,4 +73,8 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
If checkResult = False Then Exit Sub
ws.Cells(rowNum, errorCol).ClearContents
Exit Sub
ErrHandler:
lastErrorMsg = Err.Description
End Sub

5
src/sh/tuk/sheet/Z2.cls
View File

@@ -17,6 +17,7 @@ End Sub
'
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
On Error GoTo ErrHandler
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
@@ -62,4 +63,8 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
If checkResult = False Then Exit Sub
ws.Cells(rowNum, errorCol).ClearContents
Exit Sub
ErrHandler:
lastErrorMsg = Err.Description
End Sub

6
src/sh/tuk/sheet/Z3.cls
View File

@@ -17,6 +17,8 @@ End Sub
'
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
On Error GoTo ErrHandler
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
@@ -65,4 +67,8 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
If checkResult = False Then Exit Sub
ws.Cells(rowNum, errorCol).ClearContents
Exit Sub
ErrHandler:
lastErrorMsg = Err.Description
End Sub

6
src/sh/tuk/sheet/Z4.cls
View File

@@ -17,6 +17,8 @@ End Sub
'
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
On Error GoTo ErrHandler
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
@@ -69,4 +71,8 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
If checkResult = False Then Exit Sub
ws.Cells(rowNum, errorCol).ClearContents
Exit Sub
ErrHandler:
lastErrorMsg = Err.Description
End Sub

BIN
通勤手当テンプレート20260515.xlsm
View File

Binary file not shown.