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

refactor

Browse Source
This commit is contained in:
simple321vip
2026-04-19 16:44:14 +08:00
parent 4a1be61150
commit de3f513230
19 changed files with 688 additions and 1065 deletions
Download Patch File Download Diff File Expand all files Collapse all files

21
README.md
View File

@@ -1,21 +0,0 @@
## 项目结构
```
vba/
├── 通勤手当テンプレート_案.xlsm - Excel宏文件
├── 通勤手当テンプレート_案.xlsx - Excel模板
├── README.md
└── src/
├── module/ # 公共模块
│ ├── Generic_Master_Common.bas (3KB) - Master 222/223/224 通用
│ ├── Module_Common.bas (3KB) - 通用函数
│ ├── Read_Common.bas (6KB) - CSV读取
│ └── Write_Common.bas (4KB) - CSV写入
└── thisWorkbook/ # 工作簿级代码
├── Kukan_detail_master.bas (12KB) - 区間詳細マスター
├── Master_222.bas (5KB)
├── Master_223.bas (5KB)
├── Master_224.bas (5KB)
├── Master_507.bas (1KB)
└── Master_address.bas (1KB)
```

5
src/init_module/Import_modules.bas
View File

@@ -5,8 +5,9 @@ Sub ImportModulesAndSheets_Safe()
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Const MODULE_PATH As String = "D:\Project\upds7\vba\src\module"
Const SHEET_PATH As String = "D:\Project\upds7\vba\src\sheet"
Const PROJECT_PATH As String = "E:\AI\project\updsv7\vba\"
Const MODULE_PATH As String = PROJECT_PATH & "src\module"
Const SHEET_PATH As String = PROJECT_PATH & "src\sheet"
' --- Phase 1: Validation ---
Debug.Print "[LOG] Starting validation phase..."

280
src/module/Common_Button.bas
View File

@@ -4,7 +4,7 @@ Option Explicit
' Module Name: Common_Button
' Module Desc: Common_Button
' Module Methods:
' - Import
' - CSV_Import_Button
' ============================================================
Sub CSV_Import_Button()
DO_CSV_Import ActiveSheet
@@ -15,41 +15,80 @@ Sub Validation_Button()
End Sub
Sub CSV_Export_Button()
CSV_Import ActiveSheet
DO_CSV_Export ActiveSheet
End Sub
Sub Do_Sort_Button()
Sub Sort_Button()
Do_Sort ActiveSheet
End Sub
Sub Do_Filter_Button()
Sub Filter_Button()
Do_Filter ActiveSheet
End Sub
Sub Do_Fit_Button()
Sub Fit_Button()
Do_Fit ActiveSheet
End Sub
Private Sub DO_CSV_Import(ws As Excel.Worksheet)
Dim macroName As String
macroName = ws.CodeName & ".Import"
If Not ProcedureExists(ws.CodeName, "Import") Then
MsgBox "worksheet """ & ws.name & """ unimplement methods", vbExclamation
Exit Sub
End If
On Error GoTo ErrorHandler
Application.Run macroName, ws
Exit Sub
On Error GoTo ImportError
ErrorHandler:
MsgBox "error" & Err.Description, vbCritical
' Step 1: get csv encoding
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim cfg As Object: Set cfg = sheetConfDict(ws.CodeName)
Dim expectedColumnCount As Long: expectedColumnCount = cfg("ExpectedColumnCount")
' Step 2: Select CSV file
Dim filePath As String: filePath = SelectCSVFile()
If filePath = "" Then Exit Sub
' 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
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 ===
Application.ScreenUpdating = False
Application.EnableEvents = False
Call ClearDataRows(ws)
' === Step 4: Write CSV data to worksheet ===
Dim colLetters As Variant: colLetters = cfg("HeaderColumns")
Dim writeRow As Long: writeRow = cfg("StartRow")
Dim i As Long
For i = LBound(csvData, 1) To UBound(csvData, 1)
Dim j As Long
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
MsgBox writeRow - cfg("StartRow") & " rows imported.", vbInformation
GoTo FinallyExit
ImportError:
MsgBox "CSV import failed: " & Err.Description, vbExclamation
FinallyExit:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
'
Private Sub Do_Validation(ws As Excel.Worksheet)
If dataRangeDict Is Nothing Then Call RefreshDataRangeDict
Dim dataRange As Variant: dataRange = dataRangeDict(ws.CodeName)
On Error GoTo ErrorHandler
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
' step1. confirm Validate Sub
Dim validate As String
@@ -60,46 +99,193 @@ Private Sub Do_Validation(ws As Excel.Worksheet)
Exit Sub
End If
' step2. confirm data range
Dim lastDataRow As Long, r As Long, errorCount As Long
lastDataRow = GetLastDataRowInRange(ws)
Dim errorCount As Long
Dim isValid As Boolean: isValid = RunValidationSilent(ws, errorCount)
If errorCount = -1 Then
MsgBox "worksheet """ & ws.Name & """ unimplement methods", vbExclamation
ElseIf errorCount = -2 Then
MsgBox "Validation error occurred.", vbCritical
ElseIf errorCount > 0 Then
MsgBox "Validation complete. Errors: " & errorCount, vbInformation
Else
'There is no error
Dim cacheMethodName As String: cacheMethodName = Trim(sheetConf("RefreshCacheName"))
If cacheMethodName <> "" Then
Application.Run cacheMethodName
End If
MsgBox "Validation complete. Errors: 0", vbInformation
End If
Exit Sub
ErrorHandler:
MsgBox "Error: " & Err.Description, vbCritical
Exit Sub
End Sub
'
Private Sub DO_CSV_Export(ws As Excel.Worksheet)
On Error GoTo ExportError
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(ws)
Dim startRow As Long: startRow = sheetConf("StartRow")
Dim startRow As Long: startRow = dataRange(3)
Dim errorCol As Long: errorCol = ws.Range(dataRange(2) & "1").Column
If lastDataRow < startRow Then
MsgBox "No data found.", vbExclamation
MsgBox "No data rows to output.", vbExclamation
Exit Sub
End If
' === Step 1: Validate all rows before export ===
' Do_Validation
Dim errorCount As Long
If Not RunValidationSilent(ws, errorCount) Then
If errorCount > 0 Then
MsgBox "Validation failed (" & errorCount & " errors). Export aborted.", vbCritical
Exit Sub
Else
MsgBox "Validation setup error. Export aborted.", vbCritical
Exit Sub
End If
End If
' === Step 2: Select save path ===
Dim savePath As String: savePath = GetSaveCSVPath()
If savePath = "" Then Exit Sub
' === Step 3: Count data rows ===
Dim rowCount As Long: rowCount = lastDataRow - startRow + 1
' === Step 4: Count data columns ===
Dim expectedColumnCount As Long: expectedColumnCount = sheetConf("ExpectedColumnCount")
Dim outputArr As Variant
ReDim outputArr(1 To rowCount + 1, 1 To expectedColumnCount)
' === Step 5: check export csv has header ===
Dim hasHeader As Boolean: hasHeader = sheetConf("HasHeader")
Dim dataRow As Long: dataRow = 1
' === Step 6: Build array with header and data ===
If hasHeader Then
Dim headerArr As Variant
headerArr = GetCSVHeader(ws)
Dim colIdx As Long
For colIdx = 0 To expectedColumnCount - 1
outputArr(1, colIdx + 1) = headerArr(1, colIdx + 1)
Next colIdx
dataRow = dataRow + 1
End If
Dim colLetters As Variant: colLetters = sheetConf("HeaderColumns")
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)
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
End Sub
Private Sub Do_Sort(ws As Excel.Worksheet)
MsgBox "1"
End Sub
Private Sub Do_Filter(ws As Excel.Worksheet)
On Error GoTo ErrorHandler
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
' Check if auto filter is already on
If ws.AutoFilterMode Then
ws.AutoFilterMode = False
Exit Sub
End If
Dim startCol As Long: startCol = ws.Range(sheetConf("StartCol") & "1").Column
Dim endCol As Long: endCol = ws.Range(sheetConf("EndCol") & "1").Column
Dim filterRow As Long: filterRow = sheetConf("FilterRow")
Dim filterRange As Range: Set filterRange = ws.Range(ws.Cells(filterRow, startCol), ws.Cells(filterRow, endCol))
filterRange.AutoFilter
Exit Sub
ErrorHandler:
MsgBox "Error: " & Err.Description, vbCritical
End Sub
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)
Dim startCol As String: startCol = sheetConf("StartCol")
Dim endCol As String: endCol = sheetConf("EndCol")
ws.Columns(startCol & ":" & endCol).AutoFit
Exit Sub
ErrorHandler:
MsgBox "Error: " & Err.Description, vbCritical
End Sub
' RunValidationSilent
private Function RunValidationSilent(ws As Worksheet, Optional ByRef errorCountOut As Long = 0) As Boolean
On Error GoTo ErrorHandler
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
' check Validate method exist
If Not ProcedureExists(ws.CodeName, "Validate") Then
errorCountOut = -1
RunValidationSilent = False
Exit Function
End If
Dim validate As String: validate = ws.CodeName & ".Validate"
Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(ws)
Dim startRow As Long: startRow = sheetConf("StartRow")
Dim errorCol As Long: errorCol = ws.Range(sheetConf("ErrorCol") & "1").Column
If lastDataRow < startRow Then
errorCountOut = 0
RunValidationSilent = True
Exit Function
End If
Dim r As Long
errorCountOut = 0
For r = startRow To lastDataRow
On Error GoTo ErrorHandler
Application.Run validate, ws, r, lastDataRow
If Trim(ws.Cells(r, errorCol).Value) <> "" Then
errorCount = errorCount + 1
errorCountOut = errorCountOut + 1
End If
Next r
' === Refresh ws cache after validation passes ===
If errorCount = 0 Then
Dim cacheMethodName As String: cacheMethodName = dataRange(5)
If
'' TODO
Call RefreshM1Cache
End If
MsgBox "Validation complete. Errors: " & errorCount, vbInformation
RunValidationSilent = (errorCountOut = 0)
Exit Function
ErrorHandler:
MsgBox "error" & Err.Description, vbCritical
End Sub
errorCountOut = -2
RunValidationSilent = False
End Function
Private Function ProcedureExists(moduleName As String, procName As String) As Boolean
Dim VBProj As Object, VBComp As Object, CodeMod As Object

82
src/module/Common_Functions.bas
View File

@@ -15,7 +15,15 @@ Option Explicit
' Common Functions
' Get CSV header from specified row and columns
Function GetCSVHeader(ByVal ws As Worksheet, ByVal colLetters As Variant, ByVal headerRow As Long) As Variant
Function GetCSVHeader(ByVal ws As Worksheet) As Variant
On Error GoTo ErrorHandler
'
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
Dim colLetters As Variant: colLetters = sheetConf("HeaderColumns")
Dim headerRow As Long: headerRow = sheetConf("HeaderRow")
Dim colCount As Long: colCount = UBound(colLetters) - LBound(colLetters) + 1
Dim headerArr() As String
ReDim headerArr(1 To 1, 1 To colCount)
@@ -23,7 +31,10 @@ Function GetCSVHeader(ByVal ws As Worksheet, ByVal colLetters As Variant, ByVal
Dim i As Long
Dim cellValue As String
For i = 0 To colCount - 1
cellValue = Trim(ws.Cells(headerRow, Columns(colLetters(i)).Column).Value)
Dim colIndex As Long
colIndex = Columns(colLetters(i)).Column
cellValue = Trim(ws.Cells(headerRow, colIndex).Value)
cellValue = Replace(cellValue, vbLf, "")
cellValue = Replace(cellValue, vbCr, "")
cellValue = Replace(cellValue, vbCrLf, "")
@@ -31,8 +42,13 @@ Function GetCSVHeader(ByVal ws As Worksheet, ByVal colLetters As Variant, ByVal
Next i
GetCSVHeader = headerArr
Exit Function
ErrorHandler:
Err.Raise 1005, "GetCSVHeader", "Invalid column letter in HeaderColumns: '" & colLetters(i) & "'"
End Function
'
Function CleanCSVField(ByVal inputStr As String) As String
Dim s As String
s = Trim(inputStr)
@@ -139,16 +155,16 @@ End Function
' obtain
Function GetLastDataRowInRange(ws As Worksheet) As Long
If dataRangeDict Is Nothing Then Call RefreshDataRangeDict
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
If dataRangeDict.Exists(ws.CodeName) Then
Dim dataRange As Variant: dataRange = dataRangeDict(ws.CodeName)
If sheetConfDict.Exists(ws.CodeName) Then
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
Dim startCol As Long, endCol As Long, startRow As Long
On Error GoTo InvalidColumn
startCol = ws.Range(dataRange(0) & "1").Column
endCol = ws.Range(dataRange(1) & "1").Column
startRow = dataRange(3)
startCol = ws.Range(sheetConf("StartCol") & "1").Column
endCol = ws.Range(sheetConf("EndCol") & "1").Column
startRow = sheetConf("StartRow")
On Error GoTo 0
' --- query max row ---
@@ -179,15 +195,37 @@ Function ClearDataRow(ByVal ws As Worksheet, ByVal startCol As Long, ByVal endCo
End If
End Function
Function ClearDataRows(ByVal ws As Worksheet, ByVal startCol As Long, ByVal endCol As Long, Optional ByVal startRow As Long = 7)
Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(ws, startCol, endCol, startRow)
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
End If
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
'
Dim startRow As Long: startRow = sheetConf("StartRow")
Dim startCol As String: startCol = sheetConf("StartCol")
Dim endCol As String: endCol = sheetConf("EndCol")
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
'
Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(ws)
'
If lastDataRow >= startRow Then
Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(startRow, startCol), ws.Cells(lastDataRow, endCol))
Dim clearRange As Range
Set clearRange = ws.Range(ws.Cells(startRow, ws.Range(startCol & "1").Column), ws.Cells(lastDataRow, ws.Range(endCol & "1").Column))
clearRange.ClearContents
clearRange.Interior.Color = vbWhite
Dim clearErrorRange As Range
Set clearErrorRange = ws.Range(ws.Cells(startRow, ws.Range(errorCol & "1").Column), ws.Cells(lastDataRow, ws.Range(errorCol & "1").Column))
clearErrorRange.ClearContents
clearErrorRange.Interior.Color = vbWhite
End If
End Function
End Sub
Sub SortDataRows(Optional ByVal sortColumn As Long = 3)
Dim ws As Worksheet
@@ -226,26 +264,6 @@ Sub SortDataRows(Optional ByVal sortColumn As Long = 3)
Header:=xlNo
End Sub
Sub ToggleAutoFilter(ByVal startColumn As Long, ByVal endColumn As Long, Optional ByVal filterRow As Long = 6)
Dim ws As Worksheet: Set ws = ActiveSheet
' Check if auto filter is already on
If ws.AutoFilterMode Then
ws.AutoFilterMode = False
Exit Sub
End If
If startColumn < 1 Or endColumn < startColumn Then Exit Sub
Dim filterRange As Range: Set filterRange = ws.Range(ws.Cells(filterRow, startColumn), ws.Cells(filterRow, endColumn))
filterRange.AutoFilter
End Sub
Sub AutoFitColumnWidth(ByVal fitColumnStart As Long, ByVal fitColumnEnd As Long)
Dim ws As Worksheet: Set ws = ActiveSheet
If fitColumnStart <= fitColumnEnd Then
ws.Range(ws.Columns(fitColumnStart), ws.Columns(fitColumnEnd)).AutoFit
End If
End Sub
' Format: code:value (no space around colon)
Function MakeSelect(ByVal code As String, ByVal value As String) As String
MakeSelect = Trim(code) & ":" & Trim(value)

95
src/module/Common_Generic_Master.bas
View File

@@ -1,95 +0,0 @@
Attribute VB_Name = "Common_Generic_Master"
Option Explicit
' ============================================================
' Module Name: Generic_Master_Common
' Module Desc: Generic Master Import/Export functions
' Module Methods:
' - Generic_Master_Import
' - Generic_Master_Export
' - Generic_ClearDataRows
' - GetCSVHeader
' ============================================================
Sub Generic_Master_Import(ByVal ws As Worksheet, ByVal expectedColumnCount As Long)
On Error GoTo ErrorHandler
' Step 1: Select CSV file
Dim filePath As String: filePath = SelectCSVFile()
If filePath = "" Then Exit Sub
' Step 2: Read CSV and return 2D array
Dim lines As Variant: lines = ReadCSVAs2DArrayStrict(filePath, expectedColumnCount, "utf-8")
' Step 3: Clear data rows
Call Generic_ClearDataRows(ws, 7, 3)
' Step 4: Import data
Dim i As Long
Dim writeRow As Long: writeRow = 7
For i = LBound(lines, 1) To UBound(lines, 1)
If Not isRowEmpty Then
Dim colOffset As Long
For colOffset = 1 To expectedColumnCount
ws.Cells(writeRow, 2 + colOffset).Value = CleanCSVField(CStr(lines(i, colOffset)))
Next colOffset
writeRow = writeRow + 1
End If
Next i
MsgBox writeRow - 7 & " rows imported.", vbInformation
Exit Sub
ErrorHandler:
MsgBox "Import fails:" & vbCrLf & Err.Description, vbCritical
End Sub
Sub Generic_Master_Export(ByVal ws As Worksheet, ByVal expectedColumnCount As Long, ByVal lastDataRow As Long)
Dim savePath As String: savePath = GetSaveCSVPath()
If savePath = "" Then Exit Sub
' Count valid rows first (C column non-empty from row 7 onward)
Dim rowCount As Long: rowCount = 0
Dim r As Long
For r = 7 To lastDataRow
If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then
rowCount = rowCount + 1
End If
Next r
' If no data, exit
If rowCount = 0 Then
MsgBox "No data rows to output.", vbExclamation
Exit Sub
End If
' Initialize 2D array: (1 To rowCount, 1 To expectedColumnCount) for columns C-I (3 to expectedColumnCount + 2)
Dim dataArray() As Variant
ReDim dataArray(1 To rowCount, 1 To expectedColumnCount)
' Fill the array
Dim dataIdx As Long: dataIdx = 0
Dim j As Long
For r = 7 To lastDataRow
If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then
dataIdx = dataIdx + 1
For j = 3 To expectedColumnCount + 2
dataArray(dataIdx, j - 2) = ws.Cells(r, j).Value ' C->1, D->2, ..., I->7
Next j
End If
Next r
' Write using the new array-based CSV writer
Call WriteCSVFromArray(savePath, dataArray, "utf-8", True)
MsgBox "CSV export completed. Total data rows: " & rowCount, vbInformation
End Sub
Sub Generic_ClearDataRows(ByVal ws As Worksheet, ByVal startRow As Long, ByVal columnNum As Long)
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, columnNum).End(xlUp).Row
If lastRow >= startRow Then
ws.Range(ws.Cells(startRow, 1), ws.Cells(lastRow, 20)).ClearContents
End If
End Sub

278
src/module/Common_Global_Cache.bas
View File

@@ -10,26 +10,27 @@ Option Explicit
' - RefreshZ1Cache
' - RefreshZ2Cache
' - RefreshZ3Cache
' - RefreshZ4Cache
' - RefreshO1Cache
' - RefreshO2Cache
' ============================================================
' Cache Variables
Public m1Cache As Object
Public m1KukanDCache As Object
Public z1Cache As Object
Public z2Cache As Object
Public z3Cache As Object
Public z4Cache As Object
Public o1Cache As Object
Public o2Cache As Object
Public m2Cache As Object
Public tokubetuList As Object
Public oufukuList As Object
Public koutaiList As Object
Public higaitouList As Object
Private m1Cache As Object
Private m1KukanDCache As Object
Private z1Cache As Object
Private z2Cache As Object
Private z3Cache As Object
Private z4Cache As Object
Private o1Cache As Object
Private o2Cache As Object
Private m2Cache As Object
Private tokubetuList As Object
Private oufukuList As Object
Private koutaiList As Object
Private higaitouList As Object
Public dataRangeDict As Object
Private sheetConfDict As Object
' m1Cache - used by M2_Kukan_detail, Tukin_C1
' m1KukanDCache - nested dict {D: {F: [G]}}
@@ -43,7 +44,7 @@ Public dataRangeDict As Object
' ============================================================
' M1 Cache - { 区間コード[C]: [value1-7] }
' ============================================================
Public Sub RefreshM1Cache()
Private Sub RefreshM1Cache(Optional ByVal charset As String = "cp932")
Set m1Cache = Nothing
On Error GoTo RefreshError
@@ -62,7 +63,7 @@ End Sub
' Refresh M1_KukanD cache - nested dict {D: {F: [G]}}
' Structure: { 交通機関区分[D]: { 利用区間発名[F]: [利用区間着名G] } }
Public Sub RefreshM1KukanDCache()
Private Sub RefreshM1KukanDCache()
Set m1KukanDCache = Nothing
Set m1KukanDCache = CreateObject("Scripting.Dictionary")
@@ -109,7 +110,7 @@ End Sub
' M2 Cache - Nested Dictionary
' Structure: { 区間コード[C]: { 券種[I]: { コード[J]: K } } }
' ============================================================
Public Sub RefreshM2Cache()
Private Sub RefreshM2Cache()
Set m2Cache = Nothing
Set m2Cache = CreateObject("Scripting.Dictionary")
@@ -157,7 +158,7 @@ End Sub
' ============================================================
' Z1 Cache
' ============================================================
Public Sub RefreshZ1Cache()
Private Sub RefreshZ1Cache()
Set z1Cache = Nothing
On Error GoTo RefreshError
@@ -177,7 +178,7 @@ End Sub
' ============================================================
' Z2 Cache
' ============================================================
Public Sub RefreshZ2Cache()
Private Sub RefreshZ2Cache()
Set z2Cache = Nothing
On Error GoTo RefreshError
@@ -197,7 +198,7 @@ End Sub
' ============================================================
' Z3 Cache
' ============================================================
Public Sub RefreshZ3Cache()
Private Sub RefreshZ3Cache()
Set z3Cache = Nothing
On Error GoTo RefreshError
@@ -217,7 +218,7 @@ End Sub
' ============================================================
' z4Cache
' ============================================================
Public Sub RefreshZ4Cache()
Private Sub RefreshZ4Cache()
On Error GoTo RefreshError
Set z4Cache = LoadLookup("Z4", keyCol:=3, valueCols:=Array(4), startRow:=7)
On Error GoTo 0
@@ -235,7 +236,7 @@ End Sub
' ============================================================
' O1 Cache
' ============================================================
Public Sub RefreshO1Cache()
Private Sub RefreshO1Cache()
Set o1Cache = Nothing
Set o1Cache = CreateObject("Scripting.Dictionary")
@@ -287,7 +288,7 @@ End Sub
' ============================================================
' O2 Cache
' ============================================================
Public Sub RefreshO2Cache()
Private Sub RefreshO2Cache()
Set o2Cache = Nothing
On Error GoTo RefreshError
@@ -307,7 +308,7 @@ End Sub
' ============================================================
' tokubetuList
' ============================================================
Public Sub GetTokubetu()
Private Sub RefreshTokubetu()
On Error GoTo RefreshError
Set tokubetuList = LoadLookup("Enum", keyCol:=1, valueCols:=Array(1), startRow:=3)
On Error GoTo 0
@@ -325,7 +326,7 @@ End Sub
' ============================================================
' oufukuList
' ============================================================
Public Sub GetOufukuList()
Private Sub RefreshOufukuList()
On Error GoTo RefreshError
Set oufukuList = LoadLookup("Enum", keyCol:=6, valueCols:=Array(7), startRow:=3)
On Error GoTo 0
@@ -343,7 +344,7 @@ End Sub
' ============================================================
' koutaiList
' ============================================================
Public Sub GetKoutaiList()
Private Sub RefreshKoutaiList()
On Error GoTo RefreshError
Set koutaiList = LoadLookup("Enum", keyCol:=9, valueCols:=Array(10), startRow:=3)
On Error GoTo 0
@@ -361,7 +362,7 @@ End Sub
' ============================================================
' higaitouList
' ============================================================
Public Sub GetHigaitouList()
Private Sub RefreshHigaitouList()
On Error GoTo RefreshError
Set higaitouList = LoadLookup("Enum", keyCol:=12, valueCols:=Array(13), startRow:=3)
On Error GoTo 0
@@ -376,8 +377,221 @@ RefreshError:
Err.Raise 1001, "GetHigaitouList", "Failed to load Enum lookup cache: " & Err.Description
End Sub
' sheetName : [START_COL, END_COL, ERROR_COL, START_ROW, HEADER_ROW, RefaushCacheName]
Public Sub RefreshDataRangeDict()
Set dataRangeDict = CreateObject("Scripting.Dictionary")
dataRangeDict("M1") = Array("C", "N", "O", 7, 5, "RefreshM1Cache")
End Sub
Private Sub RefreshSheetDict()
Set sheetConfDict = CreateObject("Scripting.Dictionary")
Dim sheetConf As Object
' M1
Set sheetConf = CreateObject("Scripting.Dictionary")
sheetConf("StartCol") = "C"
sheetConf("EndCol") = "N"
sheetConf("ErrorCol") = "O"
sheetConf("StartRow") = 7
sheetConf("HeaderRow") = 5
sheetConf("RefreshCacheName") = "RefreshM1Cache"
sheetConf("CSV_Encoding") = "shift_jis"
sheetConf("HasHeader") = True
sheetConf("ExpectedColumnCount") = 12
sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N")
sheetConf("AlwaysQuote") = False
sheetConf("FilterRow") = 6
Set sheetConfDict("M1") = sheetConf
' M2
Set sheetConf = CreateObject("Scripting.Dictionary")
sheetConf("StartCol") = "C"
sheetConf("EndCol") = "R"
sheetConf("ErrorCol") = "S"
sheetConf("StartRow") = 7
sheetConf("HeaderRow") = 5
sheetConf("RefreshCacheName") = "RefreshM2Cache"
sheetConf("CSV_Encoding") = "shift_jis"
sheetConf("HasHeader") = True
sheetConf("ExpectedColumnCount") = 11
sheetConf("HeaderColumns") = Array("C", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R")
sheetConf("AlwaysQuote") = False
sheetConf("FilterRow") = 6
Set sheetConfDict("M2") = sheetConf
' Z1
Set sheetConf = CreateObject("Scripting.Dictionary")
sheetConf("StartCol") = "C"
sheetConf("EndCol") = "I"
sheetConf("ErrorCol") = "B"
sheetConf("StartRow") = 7
sheetConf("HeaderRow") = 5
sheetConf("RefreshCacheName") = "RefreshZ1Cache"
sheetConf("CSV_Encoding") = "utf-8"
sheetConf("HasHeader") = False
sheetConf("ExpectedColumnCount") = 7
sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I")
sheetConf("AlwaysQuote") = True
sheetConf("FilterRow") = 6
Set sheetConfDict("Z1") = sheetConf
' Z2
Set sheetConf = CreateObject("Scripting.Dictionary")
sheetConf("StartCol") = "C"
sheetConf("EndCol") = "G"
sheetConf("ErrorCol") = "B"
sheetConf("StartRow") = 7
sheetConf("HeaderRow") = 5
sheetConf("RefreshCacheName") = "RefreshZ2Cache"
sheetConf("CSV_Encoding") = "utf-8"
sheetConf("HasHeader") = False
sheetConf("ExpectedColumnCount") = 5
sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G")
sheetConf("AlwaysQuote") = True
sheetConf("FilterRow") = 6
Set sheetConfDict("Z2") = sheetConf
' Z3
Set sheetConf = CreateObject("Scripting.Dictionary")
sheetConf("StartCol") = "C"
sheetConf("EndCol") = "H"
sheetConf("ErrorCol") = "B"
sheetConf("StartRow") = 7
sheetConf("HeaderRow") = 5
sheetConf("RefreshCacheName") = "RefreshZ3Cache"
sheetConf("CSV_Encoding") = "utf-8"
sheetConf("HasHeader") = False
sheetConf("ExpectedColumnCount") = 6
sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H")
sheetConf("AlwaysQuote") = True
sheetConf("FilterRow") = 6
Set sheetConfDict("Z3") = sheetConf
' Z4
Set sheetConf = CreateObject("Scripting.Dictionary")
sheetConf("StartCol") = "C"
sheetConf("EndCol") = "I"
sheetConf("ErrorCol") = "B"
sheetConf("StartRow") = 7
sheetConf("HeaderRow") = 5
sheetConf("RefreshCacheName") = "RefreshZ4Cache"
sheetConf("CSV_Encoding") = "utf-8"
sheetConf("HasHeader") = False
sheetConf("ExpectedColumnCount") = 7
sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I")
sheetConf("AlwaysQuote") = True
sheetConf("FilterRow") = 6
Set sheetConfDict("Z4") = sheetConf
' O1
Set sheetConf = CreateObject("Scripting.Dictionary")
sheetConf("StartCol") = "C"
sheetConf("EndCol") = "F"
sheetConf("ErrorCol") = ""
sheetConf("StartRow") = 7
sheetConf("HeaderRow") = ""
sheetConf("RefreshCacheName") = "RefreshO1Cache"
sheetConf("CSV_Encoding") = "utf-8"
sheetConf("HasHeader") = False
sheetConf("ExpectedColumnCount") = 7
sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I")
sheetConf("AlwaysQuote") = True
sheetConf("FilterRow") = 6
Set sheetConfDict("O1") = sheetConf
' O2
Set sheetConf = CreateObject("Scripting.Dictionary")
sheetConf("StartCol") = "C"
sheetConf("EndCol") = "O"
sheetConf("ErrorCol") = ""
sheetConf("StartRow") = 7
sheetConf("HeaderRow") = ""
sheetConf("RefreshCacheName") = "RefreshO2Cache"
sheetConf("CSV_Encoding") = "utf-8"
sheetConf("HasHeader") = False
sheetConf("ExpectedColumnCount") = 7
sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I")
sheetConf("AlwaysQuote") = True
sheetConf("FilterRow") = 6
Set sheetConfDict("O2") = sheetConf
End Sub
Public Function GetSheetConfig() As Object
If sheetConfDict Is Nothing Then Call RefreshSheetDict
Set GetSheetConfig = sheetConfDict
End Function
Public Function GetM1Cache() As Object
If m1Cache Is Nothing Then Call RefreshM1Cache
Set GetM1Cache = m1Cache
End Function
Public Function GetM1KukanDCache() As Object
If m1KukanDCache Is Nothing Then Call RefreshM1KukanDCache
Set GetM1KukanDCache = m1KukanDCache
End Function
Public Function GetM2Cache() As Object
If m2Cache Is Nothing Then Call RefreshM2Cache
Set GetM2Cache = m2Cache
End Function
Public Function GetZ1Cache() As Object
If z1Cache Is Nothing Then Call RefreshZ1Cache
Set GetZ1Cache = z1Cache
End Function
Public Function GetZ2Cache() As Object
If z2Cache Is Nothing Then Call RefreshZ2Cache
Set GetZ2Cache = z2Cache
End Function
Public Function GetZ3Cache() As Object
If z3Cache Is Nothing Then Call RefreshZ3Cache
Set GetZ3Cache = z3Cache
End Function
Public Function GetZ4Cache() As Object
If z4Cache Is Nothing Then Call RefreshZ4Cache
Set GetZ4Cache = z4Cache
End Function
Public Function GetO1Cache() As Object
If o1Cache Is Nothing Then Call RefreshO1Cache
Set GetO1Cache = o1Cache
End Function
Public Function GetO2Cache() As Object
If o2Cache Is Nothing Then Call RefreshO2Cache
Set GetO2Cache = o2Cache
End Function
Public Function GetOufukuList() As Object
If oufukuList Is Nothing Then Call RefreshOufukuList
Set GetOufukuList = oufukuList
End Function
Public Function GetKoutaiList() As Object
If koutaiList Is Nothing Then Call RefreshKoutaiList
Set GetKoutaiList = koutaiList
End Function
Public Function GetHigaitouList() As Object
If higaitouList Is Nothing Then Call RefreshHigaitouList
Set GetHigaitouList = higaitouList
End Function
Public Function GetTokubetu() As Object
If tokubetuList Is Nothing Then Call RefreshTokubetu
Set GetTokubetu = tokubetuList
End Function

16
src/module/Common_Selector.bas
View File

@@ -17,7 +17,7 @@ Option Explicit
' Create transport (T) dropdown from Z1 cache
Public Function BuildTransportList()
If z1Cache Is Nothing Then Call RefreshZ1Cache
Dim z1Cache As Object: Set z1Cache = GetZ1Cache()
Dim dropdownList As String
Dim key As Variant
@@ -36,7 +36,7 @@ End Function
' Create todoke (G) dropdown
Public Function BuildTodokeList()
If z4Cache Is Nothing Then Call RefreshZ4Cache
Dim z4Cache As Object: Set z4Cache = GetZ4Cache()
Dim dropdownList As String
Dim key As Variant
@@ -54,7 +54,7 @@ End Function
' Create oufuku (M) dropdown
Public Function BuildOufukuList()
If oufukuList Is Nothing Then Call GetOufukuList
Dim oufukuList As Object: Set oufukuList = GetOufukuList()
Dim dropdownList As String
Dim key As Variant
@@ -72,7 +72,7 @@ End Function
' Create Koutai (N) dropdown
Public Function BuildKoutaiList()
If koutaiList Is Nothing Then Call GetKoutaiList
Dim koutaiList As Object: Set koutaiList = GetKoutaiList()
Dim dropdownList As String
Dim key As Variant
@@ -90,7 +90,7 @@ End Function
' Create Kettei (AU) dropdown
Public Function BuildKetteiList()
If z2Cache Is Nothing Then Call RefreshZ2Cache
Dim z2Cache As Object: Set z2Cache = GetZ2Cache()
Dim dropdownList As String
Dim key As Variant
@@ -108,7 +108,7 @@ End Function
' Create Higaitou (AW) dropdown
Public Function BuildHigaitouList()
If higaitouList Is Nothing Then Call GetHigaitouList
Dim higaitouList As Object: Set higaitouList = GetHigaitouList()
Dim dropdownList As String
Dim key As Variant
@@ -126,7 +126,7 @@ End Function
' Create MonthAmountKbn (AX) dropdown
Public Function BuildMonthAmountKbnList()
If z3Cache Is Nothing Then Call RefreshZ3Cache
Dim z3Cache As Object: Set z3Cache = GetZ3Cache()
Dim dropdownList As String
Dim key As Variant
@@ -144,7 +144,7 @@ End Function
' Create Kanshoku (BC) dropdown
Public Function BuildKanshokuList()
If o2Cache Is Nothing Then Call RefreshO2Cache
Dim o2Cache As Object: Set o2Cache = GetO2Cache()
Dim dropdownList As String
Dim key As Variant

65
src/sheet/C1.cls
View File

@@ -108,6 +108,7 @@ Private Sub Worksheet_Change(ByVal Target As Range)
If intersectRng Is Nothing Then Exit Sub
If Target.Row < 7 Then Exit Sub
Dim idx As Long
Application.EnableEvents = False
On Error GoTo Finally
@@ -139,7 +140,6 @@ Private Sub Worksheet_Change(ByVal Target As Range)
End If
' === Transport column changes (T, AA, AH, AO) ===
Dim idx As Long
idx = GetIdx(Target.Column, KUKAN_TRANSPORT_COLS)
If idx >= 0 Then
Dim cellT As Range
@@ -260,7 +260,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)
If m1Cache Is Nothing Then Call RefreshM1Cache
Dim m1Cache As Object: Set m1Cache = GetM1Cache()
Dim codeCol As Long: codeCol = KUKAN_CODE_COLS(idx)
Dim transportCol As Long: transportCol = KUKAN_TRANSPORT_COLS(idx)
@@ -293,7 +293,7 @@ End Sub
' Fill address dropdown from O1 cache
Private Sub FillAddressFromO1(ByVal rowNum As Long)
If o1Cache Is Nothing Then Call RefreshO1Cache
Dim o1Cache As Object: Set o1Cache = GetO1Cache()
Dim empNo As String
empNo = Trim(Me.Cells(rowNum, 3).Value)
@@ -329,7 +329,7 @@ End Sub
' Create station (利用区間発) dropdown from M1_KukanD cache
Private Sub CreateFromStationDropdown(ByVal rowNum As Long, ByVal transportCol As Long, ByVal stationCol As Long)
If m1KukanDCache Is Nothing Then Call RefreshM1KukanDCache
Dim m1KukanDCache As Object: Set m1KukanDCache = GetM1KukanDCache()
Dim transport As String: transport = GetCode(Me.Cells(rowNum, transportCol).Value)
If transport = "" Then Exit Sub
@@ -361,7 +361,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)
If m1KukanDCache Is Nothing Then Call RefreshM1KukanDCache
Dim m1KukanDCache As Object: Set m1KukanDCache = GetM1KukanDCache()
Dim transport As String: transport = GetCode(Me.Cells(rowNum, transportCol).Value)
Dim stationFrom As String: stationFrom = GetCode(Me.Cells(rowNum, stationFromCol).Value)
@@ -396,7 +396,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
If m1Cache Is Nothing Then Call RefreshM1Cache
Dim m1Cache As Object: Set m1Cache = GetM1Cache()
Dim transportKbn As String: transportKbn = GetCode(Trim(Me.Cells(rowNum, transportCol).Value))
Dim stationFrom As String: stationFrom = Trim(Me.Cells(rowNum, stationFromCol).Value)
@@ -427,7 +427,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)
If m2Cache Is Nothing Then Call RefreshM2Cache
Dim m2Cache As Object: Set m2Cache = GetM2Cache()
Dim kukanCode As String: kukanCode = Trim(Me.Cells(rowNum, kukanCodeCol).Value)
Dim kanshu As String: kanshu = Trim(Me.Cells(rowNum, kanshuCol).Value)
@@ -465,34 +465,19 @@ Private Sub ClearRowData(ByVal rowNum As Long)
Me.Cells(rowNum, ERROR_COL).ClearContents
End Sub
' ====== Button Macros ======
Private Sub validateButton()
Dim lastRow As Long, r As Long, errorCount As Long
lastRow = GetLastDataRowInRange(Me, START_COL, END_COL)
If lastRow < 7 Then
MsgBox "No data found.", vbExclamation
Exit Sub
End If
errorCount = 0
For r = 7 To lastRow
Call Validate(r)
If Trim(Cells(r, ERROR_COL).Value) <> "" Then
errorCount = errorCount + 1
End If
Next r
MsgBox "Validation complete. Errors: " & errorCount, vbInformation
End Sub
' Validation logic
Private Private Sub validate(ByVal rowNum As Long)
Set ws = Me
' Clear background color
Me.Range(Me.Cells(rowNum, START_COL), Me.Cells(rowNum, END_COL)).Interior.Color = vbWhite
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
Dim startCol As String: startCol = sheetConf("StartCol")
Dim endCol As String: endCol = sheetConf("EndCol")
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
clearRange.Interior.Color = vbWhite
' Required columns: C-G, K-N, AW
Dim requiredCols As Variant
requiredCols = Array("C", "D", "E", "F", "G", "K", "L", "M", "N", "AW")
@@ -507,15 +492,3 @@ Private Private Sub validate(ByVal rowNum As Long)
Me.Cells(rowNum, ERROR_COL).ClearContents
End Sub
Private Sub Do_Sort()
Call SortDataRows(3)
End Sub
Private Sub Do_Filter()
Call ToggleAutoFilter(START_COL, END_COL)
End Sub
Private Sub Do_Fit()
Call AutoFitColumnWidth(START_COL, END_COL)
End Sub

194
src/sheet/M1.cls
View File

@@ -2,29 +2,14 @@
' Module Name: Master_Kukan
' Module Desc: M1 Kukan master data management (import/export/validate)
' Module Methods:
' - Import
' - Export
' - validateButton_Click
' - SortData
' - ToggleAutoFilter
' - CreateEnumDropdown
' - Worksheet_Change
' - ValidateRow
' - FillValidationDropdown
' - ValidateAllRows
' - Validate
' ============================================================
' ====== Constants ======
Const START_COL As Long = 3 ' C column
Const END_COL As Long = 14 ' N column
Const ERROR_COL As Long = 15 ' O column
Const HEADER_ROW As Long = 5
Function HEADERS() As Variant
HEADERS = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N")
End Function
' Create dropdown for L column
Private Sub CreateEnumDropdown(ByVal rowNum As Long)
If tokubetuList Is Nothing Then Call GetTokubetu
Dim tokubetuList As Object: Set tokubetuList = GetTokubetu()
' Build dropdown list from tokubetuList
Dim dropdownList As String
dropdownList = ""
@@ -49,7 +34,7 @@ Private Sub CreateEnumDropdown(ByVal rowNum As Long)
End Sub
'
Private Sub Worksheet_Change(ByVal Target As Range)
' === Column C changes: Create L column dropdown ===
If Target.Column = 3 And Target.Row >= 7 Then
@@ -66,7 +51,7 @@ Private Sub Worksheet_Change(ByVal Target As Range)
' === Column D changes: Fill E column ===
If Target.Column = 4 And Target.Row >= 7 Then
If z1Cache Is Nothing Then Call RefreshZ1Cache
Dim z1Cache As Object: Set z1Cache = GetZ1Cache()
Dim cellD As Range
For Each cellD In Target
@@ -85,57 +70,23 @@ Private Sub Worksheet_Change(ByVal Target As Range)
End If
End Sub
Sub Import(wsTarget As Worksheet)
' === Step 1: Select CSV file ===
Dim filePath As String: filePath = SelectCSVFile()
If filePath = "" Then Exit Sub
Private Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
' === Step 2: Read CSV with Shift-JIS (using common function) ===
On Error GoTo ImportError
Dim csvData As Variant: csvData = ReadCSVAs2DArrayStrict(filePath, 12, "shift_jis", True)
On Error GoTo 0
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
If UBound(csvData, 1) < 1 Then
MsgBox "No data in CSV.", vbExclamation
Exit Sub
End If
' === Step 3:Clear all data rows before import ===
Application.EnableEvents = False
Call ClearDataRows(wsTarget, START_COL, END_COL, 7)
Application.EnableEvents = True
Dim startCol As String: startCol = sheetConf("StartCol")
Dim endCol As String: endCol = sheetConf("EndCol")
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
' === Step 4: Write CSV data to worksheet ===
Dim colLetters As Variant: colLetters = HEADERS()
Dim writeRow As Long: writeRow = 7
Dim i As Long
For i = LBound(csvData, 1) To UBound(csvData, 1)
' CSV col 1-12 -> C-N column
Dim j As Long
For j = 0 To 11
wsTarget.Cells(writeRow, Columns(colLetters(j)).Column).Value = CleanCSVField(CStr(csvData(i, j + 1)))
Next j
writeRow = writeRow + 1
Next i
MsgBox writeRow - 7 & " rows imported.", vbInformation
Exit Sub
ImportError:
MsgBox "CSV import failed: " & Err.Description, vbExclamation
End Sub
Private Sub validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
Dim clearRange As Range
Set clearRange = ws.Range(ws.Cells(rowNum, START_COL), ws.Cells(rowNum, END_COL))
Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
clearRange.Interior.Color = vbWhite
' Check column required
Dim colLetter As Variant
For Each colLetter In Array("C", "D", "E", "F", "G", "I", "L")
If Trim(ws.Range(colLetter & rowNum).Value) = "" Then
ws.Cells(rowNum, ERROR_COL).Value = colLetter & " column is required"
ws.Cells(rowNum, errorCol).Value = colLetter & " column is required"
ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
@@ -145,7 +96,7 @@ Private Sub validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
For Each colLetter In Array("H", "I", "J", "N")
Dim val As String: val = Trim(ws.Range(colLetter & rowNum).Value)
If val <> "" And Not IsNumeric(val) Then
ws.Cells(rowNum, ERROR_COL).Value = colLetter & " column must be numeric"
ws.Cells(rowNum, errorCol).Value = colLetter & " column must be numeric"
ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
@@ -157,27 +108,27 @@ Private Sub validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
Set foundCell = ws.Range("C7:C" & lastDataRow).Find(What:=cValue, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not foundCell Is Nothing Then
If foundCell.Row <> rowNum Then
ws.Cells(rowNum, ERROR_COL).Value = "C column value is duplicated"
ws.Cells(rowNum, errorCol).Value = "C column value is duplicated"
ws.Range("C" & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
End If
' Check D and E column in the cache
If z1Cache Is Nothing Then Call RefreshZ1Cache
Dim z1Cache As Object: Set z1Cache = GetZ1Cache()
Dim dValue As String: dValue = Trim(ws.Range("D" & rowNum).Value)
Dim eValue As String: eValue = Trim(ws.Range("E" & rowNum).Value)
If Not z1Cache.Exists(dValue) Then
ws.Cells(rowNum, ERROR_COL).Value = "D column does not exist."
ws.Cells(rowNum, errorCol).Value = "D column does not exist."
ws.Range("D" & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
Else
Dim valueArray As Variant
valueArray = z1Cache(dValue)
If Not IsArray(valueArray) Or UBound(valueArray) < 0 Then
ws.Cells(rowNum, ERROR_COL).Value = "Invalid reference data for D column."
ws.Cells(rowNum, errorCol).Value = "Invalid reference data for D column."
Exit Sub
End If
@@ -185,121 +136,22 @@ Private Sub validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
expectedEValue = Trim(CStr(valueArray(0)))
If eValue <> expectedEValue Then
ws.Cells(rowNum, ERROR_COL).Value = "E column does not match reference data."
ws.Cells(rowNum, errorCol).Value = "E column does not match reference data."
ws.Range("E" & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
End If
' Check L column in the tokubetuList
If tokubetuList Is Nothing Then Call GetTokubetu
Dim tokubetuList As Object: Set tokubetuList = GetTokubetu()
Dim lValue As String: lValue = Trim(ws.Range("L" & rowNum).Value)
If Not tokubetuList.Exists(lValue) Then
ws.Cells(rowNum, ERROR_COL).Value = "L column does not exist."
ws.Cells(rowNum, errorCol).Value = "L column does not exist."
ws.Range("L" & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
' Validation passed - clear error
ws.Cells(rowNum, ERROR_COL).ClearContents
ws.Cells(rowNum, errorCol).ClearContents
End Sub
' Validate button
Sub validateAll(ws As Worksheet)
Dim lastDataRow As Long, r As Long, errorCount As Long
lastDataRow = GetLastDataRowInRange(ws, START_COL, END_COL)
If lastDataRow < 7 Then
MsgBox "No data found.", vbExclamation
Exit Sub
End If
For r = 7 To lastDataRow
Validate r, lastDataRow
If Trim(ws.Cells(r, ERROR_COL).Value) <> "" Then
errorCount = errorCount + 1
End If
Next r
' === Refresh M1 cache after validation passes ===
If errorCount = 0 Then
Call RefreshM1Cache
End If
MsgBox "Validation complete. Errors: " & errorCount, vbInformation
End Sub
Private Sub Export()
Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(Me, START_COL, END_COL)
If lastDataRow < 7 Then
MsgBox "No data rows to output.", vbExclamation
Exit Sub
End If
' === Step 1: Validate all rows before export ===
Dim ws As Worksheet: Set ws = Me
Dim r As Long, errorCount As Long
For r = 7 To lastDataRow
Call validate(r, lastDataRow)
If Trim(ws.Cells(r, ERROR_COL).Value) <> "" Then
errorCount = errorCount + 1
End If
Next r
If errorCount > 0 Then
MsgBox "Validation failed. Found " & errorCount & " error(s). Please correct them before exporting.", vbCritical
Exit Sub
End If
' === Step 2: Select save path ===
Dim savePath As String: savePath = GetSaveCSVPath()
If savePath = "" Then Exit Sub
' === Step 3: Count data rows ===
Dim rowCount As Long: rowCount = lastDataRow - 6
' === Step 4: Build array with header and data ===
Dim headerArr As Variant
Dim colLetters As Variant: colLetters = HEADERS()
headerArr = GetCSVHeader(ws, colLetters, HEADER_ROW)
Dim outputArr As Variant
ReDim outputArr(1 To rowCount + 1, 1 To 12)
' Row 1: header
Dim colIdx As Long
For colIdx = 0 To 11
outputArr(1, colIdx + 1) = headerArr(1, colIdx + 1)
Next colIdx
' Rows 2+: data (C-N columns)
Dim dataRow As Long: dataRow = 2
For r = 7 To lastDataRow
For colIdx = 0 To 11
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, "shift_jis", False)
On Error GoTo 0
MsgBox "CSV export completed. Total data rows: " & rowCount, vbInformation
Exit Sub
ExportError:
MsgBox "CSV export failed: " & Err.Description, vbExclamation
End Sub
Private Sub Do_Sort()
Call SortDataRows(3)
End Sub
Private Sub Do_Filter()
Call ToggleAutoFilter(START_COL, END_COL)
End Sub
Private Sub Do_Fit()
Call AutoFitColumnWidth(START_COL, END_COL)
End Sub

185
src/sheet/M2.cls
View File

@@ -2,28 +2,11 @@
' Module Name: Master_Kukan_detail
' Module Desc: M2 Kukan detail master data management
' Module Methods:
' - Import
' - Export
' - validateButton_Click
' - SortData
' - ToggleAutoFilter
' - Worksheet_Change
' - ValidateRow
' - FillValidationDropdown
' - ValidateAllRows
' - FillFromM1
' - validateButton_Click
' - Validate
' ============================================================
' ====== Constants ======
Const START_COL As Long = 3 ' C column
Const END_COL As Long = 18 ' R column
Const ERROR_COL As Long = 19 ' S column
Const HEADER_ROW As Long = 6
Function HEADERS() As Variant
HEADERS = Array("C", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R")
End Function
' ====== Function ======
Private Sub Worksheet_Change(ByVal Target As Range)
' === Fill D, E when C column changes ===
If Target.Column = 3 And Target.Row >= 7 Then
@@ -38,10 +21,10 @@ Private Sub Worksheet_Change(ByVal Target As Range)
End If
End Sub
Sub FillFromM1(ByVal rowNum As Long, Optional ByVal setG As Boolean = True)
Private Sub FillFromM1(ByVal rowNum As Long, Optional ByVal setG As Boolean = True)
Set ws = Me
If m1Cache Is Nothing Then Call RefreshM1Cache
Dim m1Cache As Object: Set m1Cache = GetM1Cache()
Dim cValue As String: cValue = Trim(ws.Range("C" & rowNum).Value)
' Fill D, E, F, G, H columns from M1 cache
@@ -72,67 +55,31 @@ Sub FillFromM1(ByVal rowNum As Long, Optional ByVal setG As Boolean = True)
ws.Cells(rowNum, 8).Value = Trim(cacheVal(6))
End Sub
Sub ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long)
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
End Sub
Private Sub Import()
' === Step 1: Select CSV file ===
Dim filePath As String: filePath = SelectCSVFile()
If filePath = "" Then Exit Sub
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
' === Step 2: Read CSV with Shift-JIS (using common function) ===
On Error GoTo ImportError
Dim csvData As Variant: csvData = ReadCSVAs2DArrayStrict(filePath, 11, "shift_jis", True)
On Error GoTo 0
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
If UBound(csvData, 1) < 1 Then
MsgBox "No data in CSV.", vbExclamation
Exit Sub
End If
' === Step 3:Clear all data rows before import ===
Application.EnableEvents = False
Dim wsTarget As Worksheet: Set wsTarget = Me
Call ClearDataRows(wsTarget, START_COL, ERROR_COL, 7)
Application.EnableEvents = True
Dim startCol As String: startCol = sheetConf("StartCol")
Dim endCol As String: endCol = sheetConf("EndCol")
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
' === Step 4: Write CSV data to worksheet ===
Dim colLetters As Variant: colLetters = HEADERS()
Dim writeRow As Long: writeRow = 7
Dim i As Long
For i = LBound(csvData, 1) To UBound(csvData, 1)
' CSV col 1-11 -> C, I-R column
Dim j As Long
For j = 0 To 10
wsTarget.Cells(writeRow, Columns(colLetters(j)).Column).Value = CleanCSVField(CStr(csvData(i, j + 1)))
Next j
writeRow = writeRow + 1
Next i
MsgBox writeRow - 7 & " rows imported.", vbInformation
Exit Sub
ImportError:
MsgBox "CSV import failed: " & Err.Description, vbExclamation
End Sub
Private Sub validate(ByVal rowNum As Long, ByVal lastDataRow As Long)
Set ws = Me
Dim clearRange As Range
Set clearRange = ws.Range(ws.Cells(rowNum, START_COL), ws.Cells(rowNum, END_COL))
Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
clearRange.Interior.Color = vbWhite
' Check C column in the cache
If m1Cache Is Nothing Then Call RefreshM1Cache
Dim m1Cache As Object: Set m1Cache = GetM1Cache()
Dim cValue As String: cValue = Trim(ws.Range("C" & rowNum).Value)
If cValue <> "" AND Not m1Cache.Exists(cValue) Then
ws.Cells(rowNum, ERROR_COL).Value = "C column does not exist in M1."
ws.Cells(rowNum, errorCol).Value = "C column does not exist in M1."
ws.Range("C" & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
@@ -141,7 +88,7 @@ Private Sub validate(ByVal rowNum As Long, ByVal lastDataRow As Long)
Dim colLetter As Variant
For Each colLetter In Array("C", "I", "J", "K")
If Trim(ws.Range(colLetter & rowNum).Value) = "" Then
ws.Cells(rowNum, ERROR_COL).Value = colLetter & " column is required"
ws.Cells(rowNum, errorCol).Value = colLetter & " column is required"
ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
@@ -153,7 +100,7 @@ Private Sub validate(ByVal rowNum As Long, ByVal lastDataRow As Long)
For Each col In numericCols
Dim val As String: val = Trim(ws.Range(col & rowNum).Value & "")
If val <> "" And Not IsNumeric(val) Then
ws.Cells(rowNum, ERROR_COL).Value = col & " column must be numeric"
ws.Cells(rowNum, errorCol).Value = col & " column must be numeric"
ws.Range(col & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
@@ -163,105 +110,9 @@ Private Sub validate(ByVal rowNum As Long, ByVal lastDataRow As Long)
Dim kenshuKbn As Variant: kenshuKbn = Array("1", "2", "3")
Dim iValue As String: iValue = Trim(ws.Range("I" & rowNum).Value)
If UBound(Filter(kenshuKbn, iValue)) = -1 Then
ws.Cells(rowNum, ERROR_COL).Value = "I column (kenshuKbn) must be 1, 2, or 3"
ws.Cells(rowNum, errorCol).Value = "I column (kenshuKbn) must be 1, 2, or 3"
ws.Range("I" & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
End Sub
' Button macro (Validate selected row)
Private Sub validateButton()
Dim lastDataRow As Long, r As Long, errorCount As Long
lastDataRow = GetLastDataRowInRange(Me, START_COL, END_COL)
If lastDataRow < 7 Then
MsgBox "No data found.", vbExclamation
Exit Sub
End If
For r = 7 To lastDataRow
Validate r, lastDataRow
If Trim(Cells(r, ERROR_COL).Value) <> "" Then
errorCount = errorCount + 1
End If
Next r
MsgBox "Validation complete. Errors: " & errorCount, vbInformation
End Sub
Private Sub Export()
Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(Me, START_COL, END_COL)
If lastDataRow < 7 Then
MsgBox "No data rows to output.", vbExclamation
Exit Sub
End If
' === Step 1: Validate all rows before export ===
Dim ws As Worksheet: Set ws = Me
Dim r As Long, errorCount As Long
For r = 7 To lastDataRow
Call validate(r, lastDataRow)
If Trim(ws.Cells(r, ERROR_COL).Value) <> "" Then
errorCount = errorCount + 1
End If
Next r
If errorCount > 0 Then
MsgBox "Validation failed. Found " & errorCount & " error(s). Please correct them before exporting.", vbCritical
Exit Sub
End If
' === Step 2: Select save path ===
Dim savePath As String: savePath = GetSaveCSVPath()
If savePath = "" Then Exit Sub
' === Step 3: Count data rows ===
Dim rowCount As Long: rowCount = lastDataRow - 6
' === Step 4: Build array with header and data ===
Dim headerArr As Variant
Dim colLetters As Variant: colLetters = HEADERS()
headerArr = GetCSVHeader(ws, colLetters, HEADER_ROW)
Dim outputArr As Variant
ReDim outputArr(1 To rowCount + 1, 1 To 11)
' Row 1: header
Dim colIdx As Long
For colIdx = 0 To 10
outputArr(1, colIdx + 1) = headerArr(1, colIdx + 1)
Next colIdx
' Rows 2+: data (C, I-R columns)
Dim dataRow As Long: dataRow = 2
For r = 7 To lastDataRow
For colIdx = 0 To 10
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, "shift_jis", False)
On Error GoTo 0
MsgBox "CSV export completed. Total data rows: " & rowCount, vbInformation
Exit Sub
ExportError:
MsgBox "CSV export failed: " & Err.Description, vbExclamation
End Sub
Private Sub Do_Sort()
Call SortDataRows(3)
End Sub
Private Sub Do_Filter()
Call ToggleAutoFilter(START_COL, END_COL)
End Sub
Private Sub Do_Fit()
Call AutoFitColumnWidth(START_COL, END_COL)
End Sub

55
src/sheet/O1.cls
View File

@@ -2,59 +2,4 @@
' Module Name: Master_address
' Module Desc: O1 address master data management
' Module Methods:
' - Import
' - Export
' - SortData
' - ToggleAutoFilter
' ============================================================
Private Sub Import()
Dim filePath As String
Dim lines As Variant
Dim i As Long
Dim writeRow As Long
Set ws = Me
On Error GoTo ErrorHandler
' Step 1: Select CSV file
filePath = SelectCSVFile()
If filePath = "" Then Exit Sub
' Step 2: Read CSV and return 2D array
lines = ReadCSVAs2DArrayStrict(filePath, 4, "shift-jis", True)
' Step 3: Clear data rows
Call Generic_ClearDataRows(ws, 7, 3)
' Step 4: Import data
writeRow = 7
For i = LBound(lines, 1) To UBound(lines, 1)
If Not isRowEmpty Then
Dim colOffset As Long
For colOffset = 1 To 4
ws.Cells(writeRow, 2 + colOffset).Value = CleanCSVField(CStr(lines(i, colOffset)))
Next colOffset
writeRow = writeRow + 1
End If
Next i
MsgBox writeRow - 7 & " rows imported.", vbInformation
Exit Sub
ErrorHandler:
MsgBox "Import fails:" & vbCrLf & Err.Description, vbCritical
End Sub
Private Sub Do_Sort()
Call SortDataRows(3)
End Sub
Private Sub Do_Filter()
Call ToggleAutoFilter(3, 5)
End Sub
Private Sub Do_Fit()
Call AutoFitColumnWidth(3, 5)
End Sub

19
src/sheet/O2.cls
View File

@@ -2,24 +2,5 @@
' Module Name: Master_507
' Module Desc: O2 master data management (507)
' Module Methods:
' - Import
' - Export
' - SortData
' - ToggleAutoFilter
' ============================================================
' ====== (507) =======
Private Sub Import()
Call Generic_Master_Import(Me, 13)
End Sub
Private Sub Do_Sort()
Call SortDataRows(3)
End Sub
Private Sub Do_Filter()
Call ToggleAutoFilter(3, 15)
End Sub
Private Sub Do_Fit()
Call AutoFitColumnWidth(3, 15)
End Sub

116
src/sheet/Z1.cls
View File

@@ -2,64 +2,31 @@
' Module Name: Master_222
' Module Desc: Z1 master data management (222)
' Module Methods:
' - Import
' - Export
' - SortData
' - ToggleAutoFilter
' - Validate
' ============================================================
' ====== (222) =======
'
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
' ====== Constants ======
Const START_COL As Long = 3
Const END_COL As Long = 9
Const ERROR_COL As Long = 2
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
' ====== Function ======
Private Sub Import()
Call Generic_Master_Import(Me, 7)
End Sub
Private Sub Export()
Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(Me, START_COL, END_COL)
If lastDataRow < 7 Then
MsgBox "No data rows to output.", vbExclamation
Exit Sub
End If
Dim r As Long, errorCount As Long
For r = 7 To lastDataRow
Validate r
If Trim(Cells(r, 2).Value & "") <> "" Then
errorCount = errorCount + 1
End If
Next r
If errorCount > 0 Then
MsgBox "Validation failed. Found " & errorCount & " error(s). Please correct them before exporting.", vbCritical
Exit Sub
End If
Call Generic_Master_Export(Me, 7, lastDataRow)
End Sub
Private Sub validate(ByVal rowNum As Long)
Set ws = Me
Dim cValue As String: cValue = Trim(ws.Cells(rowNum, 3).Value)
Dim startCol As String: startCol = sheetConf("StartCol")
Dim endCol As String: endCol = sheetConf("EndCol")
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
' clear C~I columns background color
Dim clearRange As Range
Set clearRange = ws.Range(ws.Cells(rowNum, START_COL), ws.Cells(rowNum, END_COL))
Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
clearRange.Interior.Color = vbWhite
Dim cValue As String: cValue = Trim(ws.Cells(rowNum, 3).Value)
If cValue = "" Then
ws.Cells(rowNum, 2).Value = "C column is required"
ws.Cells(rowNum, errorCol).Value = "C column is required"
ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If Len(cValue) <> 3 Then
ws.Cells(rowNum, 2).Value = "C column must be 3 characters"
ws.Cells(rowNum, errorCol).Value = "C column must be 3 characters"
ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
@@ -69,7 +36,7 @@ Private Sub validate(ByVal rowNum As Long)
For i = 1 To 3
ch = Mid(cValue, i, 1)
If Not ((ch >= "0" And ch <= "9") Or (ch >= "A" And ch <= "Z") Or (ch >= "a" And ch <= "z")) Then
ws.Cells(rowNum, 2).Value = "C column must be alphanumeric"
ws.Cells(rowNum, errorCol).Value = "C column must be alphanumeric"
ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
@@ -78,12 +45,12 @@ Private Sub validate(ByVal rowNum As Long)
Dim dValue As String
dValue = Trim(ws.Cells(rowNum, 4).Value)
If dValue = "" Then
ws.Cells(rowNum, 2).Value = "D column is required"
ws.Cells(rowNum, errorCol).Value = "D column is required"
ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If Len(dValue) > 80 Then
ws.Cells(rowNum, 2).Value = "D column must be within 80 characters"
ws.Cells(rowNum, errorCol).Value = "D column must be within 80 characters"
ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
@@ -91,12 +58,12 @@ Private Sub validate(ByVal rowNum As Long)
Dim eValue As String
eValue = Trim(ws.Cells(rowNum, 5).Value)
If eValue = "" Then
ws.Cells(rowNum, 2).Value = "E column is required"
ws.Cells(rowNum, errorCol).Value = "E column is required"
ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If Len(eValue) > 80 Then
ws.Cells(rowNum, 2).Value = "E column must be within 80 characters"
ws.Cells(rowNum, errorCol).Value = "E column must be within 80 characters"
ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
@@ -104,7 +71,7 @@ Private Sub validate(ByVal rowNum As Long)
Dim fValue As String
fValue = Trim(ws.Cells(rowNum, 6).Value)
If fValue <> "" And Len(fValue) > 80 Then
ws.Cells(rowNum, 2).Value = "F column must be within 80 characters"
ws.Cells(rowNum, errorCol).Value = "F column must be within 80 characters"
ws.Cells(rowNum, 6).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
@@ -112,7 +79,7 @@ Private Sub validate(ByVal rowNum As Long)
Dim gValue As String
gValue = Trim(ws.Cells(rowNum, 7).Value)
If gValue <> "" And Len(gValue) > 80 Then
ws.Cells(rowNum, 2).Value = "G column must be within 80 characters"
ws.Cells(rowNum, errorCol).Value = "G column must be within 80 characters"
ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
@@ -121,12 +88,12 @@ Private Sub validate(ByVal rowNum As Long)
hValue = Trim(ws.Cells(rowNum, 8).Value)
If hValue <> "" Then
If Len(hValue) <> 1 Then
ws.Cells(rowNum, 2).Value = "H column must be 1 digit"
ws.Cells(rowNum, errorCol).Value = "H column must be 1 digit"
ws.Cells(rowNum, 8).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If hValue <> "0" And hValue <> "1" Then
ws.Cells(rowNum, 2).Value = "H column must be 0 or 1"
ws.Cells(rowNum, errorCol).Value = "H column must be 0 or 1"
ws.Cells(rowNum, 8).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
@@ -135,47 +102,10 @@ Private Sub validate(ByVal rowNum As Long)
Dim iValue As String
iValue = Trim(ws.Cells(rowNum, 9).Value)
If iValue <> "" And Len(iValue) > 80 Then
ws.Cells(rowNum, 2).Value = "I column must be within 80 characters"
ws.Cells(rowNum, errorCol).Value = "I column must be within 80 characters"
ws.Cells(rowNum, 9).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
ws.Cells(rowNum, 2).ClearContents
ws.Cells(rowNum, errorCol).ClearContents
End Sub
Private Sub validateButton()
Dim lastDataRow As Long, r As Long, errorCount As Long
lastDataRow = GetLastDataRowInRange(Me, START_COL, END_COL)
If lastDataRow < 7 Then
MsgBox "No data found.", vbExclamation
Exit Sub
End If
errorCount = 0
For r = 7 To lastDataRow
Validate r
If Trim(Cells(r, ERROR_COL).Value) <> "" Then
errorCount = errorCount + 1
End If
Next r
' === Refresh Z1 cache after validation passes ===
If errorCount = 0 Then
Call RefreshZ1Cache
End If
MsgBox "Validation complete. Errors: " & errorCount, vbInformation
End Sub
Private Sub Do_Sort()
Call SortDataRows(3)
End Sub
Private Sub Do_Filter()
Call ToggleAutoFilter(2, END_COL)
End Sub
Private Sub Do_Fit()
Call AutoFitColumnWidth(2, END_COL)
End Sub

112
src/sheet/Z2.cls
View File

@@ -2,64 +2,31 @@
' Module Name: Master_223
' Module Desc: Z2 master data management (223)
' Module Methods:
' - Import
' - Export
' - SortData
' - ToggleAutoFilter
' - Validate
' ============================================================
' ====== (223) =======
'
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
' ====== Constants ======
Const START_COL As Long = 3
Const END_COL As Long = 7
Const ERROR_COL As Long = 2
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
' ====== Function ======
Private Sub Import()
Call Generic_Master_Import(Me, 5)
End Sub
Private Sub Export()
Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(Me, START_COL, END_COL)
Dim startCol As String: startCol = sheetConf("StartCol")
Dim endCol As String: endCol = sheetConf("EndCol")
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
If lastDataRow < 7 Then
MsgBox "No data rows to output.", vbExclamation
Exit Sub
End If
Dim r As Long, errorCount As Long
For r = 7 To lastDataRow
Validate r
If Trim(Cells(r, 2).Value & "") <> "" Then
errorCount = errorCount + 1
End If
Next r
If errorCount > 0 Then
MsgBox "Validation failed. Found " & errorCount & " error(s). Please correct them before exporting.", vbCritical
Exit Sub
End If
Call Generic_Master_Export(Me, 5, lastDataRow)
End Sub
Private Sub validate(ByVal rowNum As Long)
Set ws = Me
Dim cValue As String: cValue = Trim(ws.Cells(rowNum, 3).Value)
' clear C~I columns background color
Dim clearRange As Range
Set clearRange = ws.Range(ws.Cells(rowNum, START_COL), ws.Cells(rowNum, END_COL))
Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
clearRange.Interior.Color = vbWhite
Dim cValue As String: cValue = Trim(ws.Cells(rowNum, 3).Value)
If cValue = "" Then
ws.Cells(rowNum, 2).Value = "C column is required"
ws.Cells(rowNum, errorCol).Value = "C column is required"
ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If Len(cValue) <> 3 Then
ws.Cells(rowNum, 2).Value = "C column must be 3 characters"
ws.Cells(rowNum, errorCol).Value = "C column must be 3 characters"
ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
@@ -69,7 +36,7 @@ Private Sub validate(ByVal rowNum As Long)
For i = 1 To 3
ch = Mid(cValue, i, 1)
If Not ((ch >= "0" And ch <= "9") Or (ch >= "A" And ch <= "Z") Or (ch >= "a" And ch <= "z")) Then
ws.Cells(rowNum, 2).Value = "C column must be alphanumeric"
ws.Cells(rowNum, errorCol).Value = "C column must be alphanumeric"
ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
@@ -78,12 +45,12 @@ Private Sub validate(ByVal rowNum As Long)
Dim dValue As String
dValue = Trim(ws.Cells(rowNum, 4).Value)
If dValue = "" Then
ws.Cells(rowNum, 2).Value = "D column is required"
ws.Cells(rowNum, errorCol).Value = "D column is required"
ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If Len(dValue) > 80 Then
ws.Cells(rowNum, 2).Value = "D column must be within 80 characters"
ws.Cells(rowNum, errorCol).Value = "D column must be within 80 characters"
ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
@@ -91,12 +58,12 @@ Private Sub validate(ByVal rowNum As Long)
Dim eValue As String
eValue = Trim(ws.Cells(rowNum, 5).Value)
If eValue = "" Then
ws.Cells(rowNum, 2).Value = "E column is required"
ws.Cells(rowNum, errorCol).Value = "E column is required"
ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If Len(eValue) > 80 Then
ws.Cells(rowNum, 2).Value = "E column must be within 80 characters"
ws.Cells(rowNum, errorCol).Value = "E column must be within 80 characters"
ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
@@ -104,7 +71,7 @@ Private Sub validate(ByVal rowNum As Long)
Dim fValue As String
fValue = Trim(ws.Cells(rowNum, 6).Value)
If fValue <> "" And Len(fValue) > 80 Then
ws.Cells(rowNum, 2).Value = "F column must be within 80 characters"
ws.Cells(rowNum, errorCol).Value = "F column must be within 80 characters"
ws.Cells(rowNum, 6).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
@@ -113,53 +80,16 @@ Private Sub validate(ByVal rowNum As Long)
hValue = Trim(ws.Cells(rowNum, 7).Value)
If hValue <> "" Then
If Len(hValue) <> 1 Then
ws.Cells(rowNum, 2).Value = "G column must be 1 digit"
ws.Cells(rowNum, errorCol).Value = "G column must be 1 digit"
ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If hValue <> "0" And hValue <> "1" Then
ws.Cells(rowNum, 2).Value = "G column must be 0 or 1"
ws.Cells(rowNum, errorCol).Value = "G column must be 0 or 1"
ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
End If
ws.Cells(rowNum, 2).ClearContents
ws.Cells(rowNum, errorCol).ClearContents
End Sub
Private Sub validateButton()
Dim lastDataRow As Long, r As Long, errorCount As Long
lastDataRow = GetLastDataRowInRange(Me, START_COL, END_COL)
If lastDataRow < 7 Then
MsgBox "No data found.", vbExclamation
Exit Sub
End If
errorCount = 0
For r = 7 To lastDataRow
Validate r
If Trim(Cells(r, ERROR_COL).Value) <> "" Then
errorCount = errorCount + 1
End If
Next r
' === Refresh Z2 cache after validation passes ===
If errorCount = 0 Then
Call RefreshZ2Cache
End If
MsgBox "Validation complete. Errors: " & errorCount, vbInformation
End Sub
Private Sub Do_Sort()
Call SortDataRows(3)
End Sub
Private Sub Do_Filter()
Call ToggleAutoFilter(2, END_COL)
End Sub
Private Sub Do_Fit()
Call AutoFitColumnWidth(2, END_COL)
End Sub

115
src/sheet/Z3.cls
View File

@@ -2,64 +2,30 @@
' Module Name: Master_Z3_224
' Module Desc: Z3 master data management (224)
' Module Methods:
' - Z3_Import
' - Z3_Export
' - Z3_SortDataRowsByC
' - Z3_ToggleAutoFilter
' - Validate
' ============================================================
' ====== (224) =======
'
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
' ====== Constants ======
Const START_COL As Long = 3
Const END_COL As Long = 8
Const ERROR_COL As Long = 2
' ====== Function ======
Private Sub Import()
Call Generic_Master_Import(Me, 6)
End Sub
Private Sub Export()
Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(Me, START_COL, END_COL)
Dim startCol As String: startCol = sheetConf("StartCol")
Dim endCol As String: endCol = sheetConf("EndCol")
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
If lastDataRow < 7 Then
MsgBox "No data rows to output.", vbExclamation
Exit Sub
End If
Dim r As Long, errorCount As Long
For r = 7 To lastDataRow
Validate r
If Trim(Cells(r, 2).Value & "") <> "" Then
errorCount = errorCount + 1
End If
Next r
If errorCount > 0 Then
MsgBox "Validation failed. Found " & errorCount & " error(s). Please correct them before exporting.", vbCritical
Exit Sub
End If
Call Generic_Master_Export(Me, 6, lastDataRow)
End Sub
Private Sub validate(ByVal rowNum As Long)
Set ws = Me
Dim cValue As String: cValue = Trim(ws.Cells(rowNum, 3).Value)
' clear C~I columns background color
Dim clearRange As Range
Set clearRange = ws.Range(ws.Cells(rowNum, START_COL), ws.Cells(rowNum, END_COL))
Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
clearRange.Interior.Color = vbWhite
Dim cValue As String: cValue = Trim(ws.Cells(rowNum, 3).Value)
If cValue = "" Then
ws.Cells(rowNum, 2).Value = "C column is required"
ws.Cells(rowNum, endCol).Value = "C column is required"
ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If Len(cValue) <> 3 Then
ws.Cells(rowNum, 2).Value = "C column must be 3 characters"
ws.Cells(rowNum, endCol).Value = "C column must be 3 characters"
ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
@@ -69,7 +35,7 @@ Private Sub validate(ByVal rowNum As Long)
For i = 1 To 3
ch = Mid(cValue, i, 1)
If Not ((ch >= "0" And ch <= "9") Or (ch >= "A" And ch <= "Z") Or (ch >= "a" And ch <= "z")) Then
ws.Cells(rowNum, 2).Value = "C column must be alphanumeric"
ws.Cells(rowNum, endCol).Value = "C column must be alphanumeric"
ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
@@ -78,12 +44,12 @@ Private Sub validate(ByVal rowNum As Long)
Dim dValue As String
dValue = Trim(ws.Cells(rowNum, 4).Value)
If dValue = "" Then
ws.Cells(rowNum, 2).Value = "D column is required"
ws.Cells(rowNum, endCol).Value = "D column is required"
ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If Len(dValue) > 80 Then
ws.Cells(rowNum, 2).Value = "D column must be within 80 characters"
ws.Cells(rowNum, endCol).Value = "D column must be within 80 characters"
ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
@@ -91,12 +57,12 @@ Private Sub validate(ByVal rowNum As Long)
Dim eValue As String
eValue = Trim(ws.Cells(rowNum, 5).Value)
If eValue = "" Then
ws.Cells(rowNum, 2).Value = "E column is required"
ws.Cells(rowNum, endCol).Value = "E column is required"
ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If Len(eValue) > 80 Then
ws.Cells(rowNum, 2).Value = "E column must be within 80 characters"
ws.Cells(rowNum, endCol).Value = "E column must be within 80 characters"
ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
@@ -104,7 +70,7 @@ Private Sub validate(ByVal rowNum As Long)
Dim fValue As String
fValue = Trim(ws.Cells(rowNum, 6).Value)
If fValue <> "" And Len(fValue) > 80 Then
ws.Cells(rowNum, 2).Value = "F column must be within 80 characters"
ws.Cells(rowNum, endCol).Value = "F column must be within 80 characters"
ws.Cells(rowNum, 6).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
@@ -113,12 +79,12 @@ Private Sub validate(ByVal rowNum As Long)
hValue = Trim(ws.Cells(rowNum, 7).Value)
If hValue <> "" Then
If Len(hValue) <> 1 Then
ws.Cells(rowNum, 2).Value = "G column must be 1 digit"
ws.Cells(rowNum, endCol).Value = "G column must be 1 digit"
ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If hValue <> "0" And hValue <> "1" Then
ws.Cells(rowNum, 2).Value = "G column must be 0 or 1"
ws.Cells(rowNum, endCol).Value = "G column must be 0 or 1"
ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
@@ -127,47 +93,10 @@ Private Sub validate(ByVal rowNum As Long)
Dim iValue As String
iValue = Trim(ws.Cells(rowNum, 8).Value)
If iValue <> "" And Len(iValue) > 80 Then
ws.Cells(rowNum, 2).Value = "H column must be within 80 characters"
ws.Cells(rowNum, endCol).Value = "H column must be within 80 characters"
ws.Cells(rowNum, 8).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
ws.Cells(rowNum, 2).ClearContents
ws.Cells(rowNum, endCol).ClearContents
End Sub
Private Sub validateButton()
Dim lastDataRow As Long, r As Long, errorCount As Long
lastDataRow = GetLastDataRowInRange(Me, START_COL, END_COL)
If lastDataRow < 7 Then
MsgBox "No data found.", vbExclamation
Exit Sub
End If
errorCount = 0
For r = 7 To lastDataRow
Validate r
If Trim(Cells(r, ERROR_COL).Value) <> "" Then
errorCount = errorCount + 1
End If
Next r
' === Refresh Z3 cache after validation passes ===
If errorCount = 0 Then
Call RefreshZ3Cache
End If
MsgBox "Validation complete. Errors: " & errorCount, vbInformation
End Sub
Private Sub Do_Sort()
Call SortDataRows(3)
End Sub
Private Sub Do_Filter()
Call ToggleAutoFilter(2, END_COL)
End Sub
Private Sub Do_Fit()
Call AutoFitColumnWidth(2, END_COL)
End Sub

115
src/sheet/Z4.cls
View File

@@ -2,64 +2,30 @@
' Module Name: Master_Z4_220
' Module Desc: Z4 master data management (220)
' Module Methods:
' - Z4_Import
' - Z4_Export
' - Z4_SortDataRowsByC
' - Z4_ToggleAutoFilter
' - Validate
' ============================================================
' ====== (220) =======
'
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
' ====== Constants ======
Const START_COL As Long = 3
Const END_COL As Long = 9
Const ERROR_COL As Long = 2
' ====== Function ======
Private Sub Import()
Call Generic_Master_Import(Me, 7)
End Sub
Private Sub Export()
Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(Me, START_COL, END_COL)
Dim startCol As String: startCol = sheetConf("StartCol")
Dim endCol As String: endCol = sheetConf("EndCol")
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
If lastDataRow < 7 Then
MsgBox "No data rows to output.", vbExclamation
Exit Sub
End If
Dim r As Long, errorCount As Long
For r = 7 To lastDataRow
Validate r
If Trim(Cells(r, 2).Value & "") <> "" Then
errorCount = errorCount + 1
End If
Next r
If errorCount > 0 Then
MsgBox "Validation failed. Found " & errorCount & " error(s). Please correct them before exporting.", vbCritical
Exit Sub
End If
Call Generic_Master_Export(Me, 7, lastDataRow)
End Sub
Private Sub validate(ByVal rowNum As Long)
Set ws = Me
Dim cValue As String: cValue = Trim(ws.Cells(rowNum, 3).Value)
' clear C~I columns background color
Dim clearRange As Range
Set clearRange = ws.Range(ws.Cells(rowNum, START_COL), ws.Cells(rowNum, END_COL))
Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
clearRange.Interior.Color = vbWhite
Dim cValue As String: cValue = Trim(ws.Cells(rowNum, 3).Value)
If cValue = "" Then
ws.Cells(rowNum, 2).Value = "C column is required"
ws.Cells(rowNum, errorCol).Value = "C column is required"
ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If Len(cValue) <> 3 Then
ws.Cells(rowNum, 2).Value = "C column must be 3 characters"
ws.Cells(rowNum, errorCol).Value = "C column must be 3 characters"
ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
@@ -69,7 +35,7 @@ Private Sub validate(ByVal rowNum As Long)
For i = 1 To 3
ch = Mid(cValue, i, 1)
If Not ((ch >= "0" And ch <= "9") Or (ch >= "A" And ch <= "Z") Or (ch >= "a" And ch <= "z")) Then
ws.Cells(rowNum, 2).Value = "C column must be alphanumeric"
ws.Cells(rowNum, errorCol).Value = "C column must be alphanumeric"
ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
@@ -78,12 +44,12 @@ Private Sub validate(ByVal rowNum As Long)
Dim dValue As String
dValue = Trim(ws.Cells(rowNum, 4).Value)
If dValue = "" Then
ws.Cells(rowNum, 2).Value = "D column is required"
ws.Cells(rowNum, errorCol).Value = "D column is required"
ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If Len(dValue) > 80 Then
ws.Cells(rowNum, 2).Value = "D column must be within 80 characters"
ws.Cells(rowNum, errorCol).Value = "D column must be within 80 characters"
ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
@@ -91,12 +57,12 @@ Private Sub validate(ByVal rowNum As Long)
Dim eValue As String
eValue = Trim(ws.Cells(rowNum, 5).Value)
If eValue = "" Then
ws.Cells(rowNum, 2).Value = "E column is required"
ws.Cells(rowNum, errorCol).Value = "E column is required"
ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If Len(eValue) > 80 Then
ws.Cells(rowNum, 2).Value = "E column must be within 80 characters"
ws.Cells(rowNum, errorCol).Value = "E column must be within 80 characters"
ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
@@ -104,7 +70,7 @@ Private Sub validate(ByVal rowNum As Long)
Dim fValue As String
fValue = Trim(ws.Cells(rowNum, 6).Value)
If fValue <> "" And Len(fValue) > 80 Then
ws.Cells(rowNum, 2).Value = "F column must be within 80 characters"
ws.Cells(rowNum, errorCol).Value = "F column must be within 80 characters"
ws.Cells(rowNum, 6).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
@@ -113,12 +79,12 @@ Private Sub validate(ByVal rowNum As Long)
hValue = Trim(ws.Cells(rowNum, 7).Value)
If hValue <> "" Then
If Len(hValue) <> 1 Then
ws.Cells(rowNum, 2).Value = "G column must be 1 digit"
ws.Cells(rowNum, errorCol).Value = "G column must be 1 digit"
ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If hValue <> "0" And hValue <> "1" Then
ws.Cells(rowNum, 2).Value = "G column must be 0 or 1"
ws.Cells(rowNum, errorCol).Value = "G column must be 0 or 1"
ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
@@ -127,47 +93,10 @@ Private Sub validate(ByVal rowNum As Long)
Dim iValue As String
iValue = Trim(ws.Cells(rowNum, 8).Value)
If iValue <> "" And Len(iValue) > 80 Then
ws.Cells(rowNum, 2).Value = "H column must be within 80 characters"
ws.Cells(rowNum, errorCol).Value = "H column must be within 80 characters"
ws.Cells(rowNum, 8).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
ws.Cells(rowNum, 2).ClearContents
ws.Cells(rowNum, errorCol).ClearContents
End Sub
Private Sub validateButton()
Dim lastDataRow As Long, r As Long, errorCount As Long
lastDataRow = GetLastDataRowInRange(Me, START_COL, END_COL)
If lastDataRow < 7 Then
MsgBox "No data found.", vbExclamation
Exit Sub
End If
errorCount = 0
For r = 7 To lastDataRow
Validate r
If Trim(Cells(r, ERROR_COL).Value) <> "" Then
errorCount = errorCount + 1
End If
Next r
' === Refresh Z4 cache after validation passes ===
If errorCount = 0 Then
Call RefreshZ4Cache
End If
MsgBox "Validation complete. Errors: " & errorCount, vbInformation
End Sub
Private Sub Do_Sort()
Call SortDataRows(3)
End Sub
Private Sub Do_Filter()
Call ToggleAutoFilter(2, END_COL)
End Sub
Private Sub Do_Fit()
Call AutoFitColumnWidth(2, END_COL)
End Sub

BIN
test.xlsm
View File

Binary file not shown.

BIN
test.xlsx
View File

Binary file not shown.

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

Binary file not shown.