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 Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject") Set fso = CreateObject("Scripting.FileSystemObject")
Const MODULE_PATH As String = "D:\Project\upds7\vba\src\module" Const PROJECT_PATH As String = "E:\AI\project\updsv7\vba\"
Const SHEET_PATH As String = "D:\Project\upds7\vba\src\sheet" Const MODULE_PATH As String = PROJECT_PATH & "src\module"
Const SHEET_PATH As String = PROJECT_PATH & "src\sheet"
' --- Phase 1: Validation --- ' --- Phase 1: Validation ---
Debug.Print "[LOG] Starting validation phase..." Debug.Print "[LOG] Starting validation phase..."

272
src/module/Common_Button.bas
View File

@@ -4,7 +4,7 @@ Option Explicit
' Module Name: Common_Button ' Module Name: Common_Button
' Module Desc: Common_Button ' Module Desc: Common_Button
' Module Methods: ' Module Methods:
' - Import ' - CSV_Import_Button
' ============================================================ ' ============================================================
Sub CSV_Import_Button() Sub CSV_Import_Button()
DO_CSV_Import ActiveSheet DO_CSV_Import ActiveSheet
@@ -15,41 +15,80 @@ Sub Validation_Button()
End Sub End Sub
Sub CSV_Export_Button() Sub CSV_Export_Button()
CSV_Import ActiveSheet DO_CSV_Export ActiveSheet
End Sub End Sub
Sub Do_Sort_Button() Sub Sort_Button()
Do_Sort ActiveSheet Do_Sort ActiveSheet
End Sub End Sub
Sub Do_Filter_Button() Sub Filter_Button()
Do_Filter ActiveSheet Do_Filter ActiveSheet
End Sub End Sub
Sub Do_Fit_Button() Sub Fit_Button()
Do_Fit ActiveSheet Do_Fit ActiveSheet
End Sub End Sub
Private Sub DO_CSV_Import(ws As Excel.Worksheet) Private Sub DO_CSV_Import(ws As Excel.Worksheet)
Dim macroName As String On Error GoTo ImportError
macroName = ws.CodeName & ".Import"
If Not ProcedureExists(ws.CodeName, "Import") Then ' Step 1: get csv encoding
MsgBox "worksheet """ & ws.name & """ unimplement methods", vbExclamation Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Exit Sub 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 End If
On Error GoTo ErrorHandler If UBound(csvData, 1) < 1 Then
Application.Run macroName, ws MsgBox "No data in CSV.", vbExclamation
Exit Sub GoTo FinallyExit
End If
ErrorHandler: ' === Step 3:Clear all data rows before import ===
MsgBox "error" & Err.Description, vbCritical 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 End Sub
'
Private Sub Do_Validation(ws As Excel.Worksheet) Private Sub Do_Validation(ws As Excel.Worksheet)
If dataRangeDict Is Nothing Then Call RefreshDataRangeDict On Error GoTo ErrorHandler
Dim dataRange As Variant: dataRange = dataRangeDict(ws.CodeName)
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
' step1. confirm Validate Sub ' step1. confirm Validate Sub
Dim validate As String Dim validate As String
@@ -60,46 +99,193 @@ Private Sub Do_Validation(ws As Excel.Worksheet)
Exit Sub Exit Sub
End If End If
' step2. confirm data range Dim errorCount As Long
Dim lastDataRow As Long, r As Long, errorCount As Long Dim isValid As Boolean: isValid = RunValidationSilent(ws, errorCount)
lastDataRow = GetLastDataRowInRange(ws)
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 If lastDataRow < startRow Then
MsgBox "No data found.", vbExclamation MsgBox "No data rows to output.", vbExclamation
Exit Sub Exit Sub
End If 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 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 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
Application.Run validate, ws, r, lastDataRow Application.Run validate, ws, r, lastDataRow
If Trim(ws.Cells(r, errorCol).Value) <> "" Then If Trim(ws.Cells(r, errorCol).Value) <> "" Then
errorCount = errorCount + 1 errorCountOut = errorCountOut + 1
End If End If
Next r Next r
' === Refresh ws cache after validation passes === RunValidationSilent = (errorCountOut = 0)
If errorCount = 0 Then Exit Function
Dim cacheMethodName As String: cacheMethodName = dataRange(5)
If
'' TODO
Call RefreshM1Cache
End If
MsgBox "Validation complete. Errors: " & errorCount, vbInformation
ErrorHandler: ErrorHandler:
MsgBox "error" & Err.Description, vbCritical errorCountOut = -2
End Sub RunValidationSilent = False
End Function
Private Function ProcedureExists(moduleName As String, procName As String) As Boolean Private Function ProcedureExists(moduleName As String, procName As String) As Boolean
Dim VBProj As Object, VBComp As Object, CodeMod As Object 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 ' Common Functions
' Get CSV header from specified row and columns ' 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 colCount As Long: colCount = UBound(colLetters) - LBound(colLetters) + 1
Dim headerArr() As String Dim headerArr() As String
ReDim headerArr(1 To 1, 1 To colCount) 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 i As Long
Dim cellValue As String Dim cellValue As String
For i = 0 To colCount - 1 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, vbLf, "")
cellValue = Replace(cellValue, vbCr, "") cellValue = Replace(cellValue, vbCr, "")
cellValue = Replace(cellValue, vbCrLf, "") cellValue = Replace(cellValue, vbCrLf, "")
@@ -31,8 +42,13 @@ Function GetCSVHeader(ByVal ws As Worksheet, ByVal colLetters As Variant, ByVal
Next i Next i
GetCSVHeader = headerArr GetCSVHeader = headerArr
Exit Function
ErrorHandler:
Err.Raise 1005, "GetCSVHeader", "Invalid column letter in HeaderColumns: '" & colLetters(i) & "'"
End Function End Function
'
Function CleanCSVField(ByVal inputStr As String) As String Function CleanCSVField(ByVal inputStr As String) As String
Dim s As String Dim s As String
s = Trim(inputStr) s = Trim(inputStr)
@@ -139,16 +155,16 @@ End Function
' obtain ' obtain
Function GetLastDataRowInRange(ws As Worksheet) As Long 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 If sheetConfDict.Exists(ws.CodeName) Then
Dim dataRange As Variant: dataRange = dataRangeDict(ws.CodeName) Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
Dim startCol As Long, endCol As Long, startRow As Long Dim startCol As Long, endCol As Long, startRow As Long
On Error GoTo InvalidColumn On Error GoTo InvalidColumn
startCol = ws.Range(dataRange(0) & "1").Column startCol = ws.Range(sheetConf("StartCol") & "1").Column
endCol = ws.Range(dataRange(1) & "1").Column endCol = ws.Range(sheetConf("EndCol") & "1").Column
startRow = dataRange(3) startRow = sheetConf("StartRow")
On Error GoTo 0 On Error GoTo 0
' --- query max row --- ' --- query max row ---
@@ -179,15 +195,37 @@ Function ClearDataRow(ByVal ws As Worksheet, ByVal startCol As Long, ByVal endCo
End If End If
End Function End Function
Function ClearDataRows(ByVal ws As Worksheet, ByVal startCol As Long, ByVal endCol As Long, Optional ByVal startRow As Long = 7) Sub ClearDataRows(ByVal ws As Worksheet)
Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(ws, startCol, endCol, startRow) '
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 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.ClearContents
clearRange.Interior.Color = vbWhite 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 If
End Function End Sub
Sub SortDataRows(Optional ByVal sortColumn As Long = 3) Sub SortDataRows(Optional ByVal sortColumn As Long = 3)
Dim ws As Worksheet Dim ws As Worksheet
@@ -226,26 +264,6 @@ Sub SortDataRows(Optional ByVal sortColumn As Long = 3)
Header:=xlNo Header:=xlNo
End Sub 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) ' Format: code:value (no space around colon)
Function MakeSelect(ByVal code As String, ByVal value As String) As String Function MakeSelect(ByVal code As String, ByVal value As String) As String
MakeSelect = Trim(code) & ":" & Trim(value) 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

276
src/module/Common_Global_Cache.bas
View File

@@ -10,26 +10,27 @@ Option Explicit
' - RefreshZ1Cache ' - RefreshZ1Cache
' - RefreshZ2Cache ' - RefreshZ2Cache
' - RefreshZ3Cache ' - RefreshZ3Cache
' - RefreshZ4Cache
' - RefreshO1Cache ' - RefreshO1Cache
' - RefreshO2Cache ' - RefreshO2Cache
' ============================================================ ' ============================================================
' Cache Variables ' Cache Variables
Public m1Cache As Object Private m1Cache As Object
Public m1KukanDCache As Object Private m1KukanDCache As Object
Public z1Cache As Object Private z1Cache As Object
Public z2Cache As Object Private z2Cache As Object
Public z3Cache As Object Private z3Cache As Object
Public z4Cache As Object Private z4Cache As Object
Public o1Cache As Object Private o1Cache As Object
Public o2Cache As Object Private o2Cache As Object
Public m2Cache As Object Private m2Cache As Object
Public tokubetuList As Object Private tokubetuList As Object
Public oufukuList As Object Private oufukuList As Object
Public koutaiList As Object Private koutaiList As Object
Public higaitouList As Object Private higaitouList As Object
Public dataRangeDict As Object Private sheetConfDict As Object
' m1Cache - used by M2_Kukan_detail, Tukin_C1 ' m1Cache - used by M2_Kukan_detail, Tukin_C1
' m1KukanDCache - nested dict {D: {F: [G]}} ' m1KukanDCache - nested dict {D: {F: [G]}}
@@ -43,7 +44,7 @@ Public dataRangeDict As Object
' ============================================================ ' ============================================================
' M1 Cache - { 区間コード[C]: [value1-7] } ' M1 Cache - { 区間コード[C]: [value1-7] }
' ============================================================ ' ============================================================
Public Sub RefreshM1Cache() Private Sub RefreshM1Cache(Optional ByVal charset As String = "cp932")
Set m1Cache = Nothing Set m1Cache = Nothing
On Error GoTo RefreshError On Error GoTo RefreshError
@@ -62,7 +63,7 @@ End Sub
' Refresh M1_KukanD cache - nested dict {D: {F: [G]}} ' Refresh M1_KukanD cache - nested dict {D: {F: [G]}}
' Structure: { 交通機関区分[D]: { 利用区間発名[F]: [利用区間着名G] } } ' Structure: { 交通機関区分[D]: { 利用区間発名[F]: [利用区間着名G] } }
Public Sub RefreshM1KukanDCache() Private Sub RefreshM1KukanDCache()
Set m1KukanDCache = Nothing Set m1KukanDCache = Nothing
Set m1KukanDCache = CreateObject("Scripting.Dictionary") Set m1KukanDCache = CreateObject("Scripting.Dictionary")
@@ -109,7 +110,7 @@ End Sub
' M2 Cache - Nested Dictionary ' M2 Cache - Nested Dictionary
' Structure: { 区間コード[C]: { 券種[I]: { コード[J]: K } } } ' Structure: { 区間コード[C]: { 券種[I]: { コード[J]: K } } }
' ============================================================ ' ============================================================
Public Sub RefreshM2Cache() Private Sub RefreshM2Cache()
Set m2Cache = Nothing Set m2Cache = Nothing
Set m2Cache = CreateObject("Scripting.Dictionary") Set m2Cache = CreateObject("Scripting.Dictionary")
@@ -157,7 +158,7 @@ End Sub
' ============================================================ ' ============================================================
' Z1 Cache ' Z1 Cache
' ============================================================ ' ============================================================
Public Sub RefreshZ1Cache() Private Sub RefreshZ1Cache()
Set z1Cache = Nothing Set z1Cache = Nothing
On Error GoTo RefreshError On Error GoTo RefreshError
@@ -177,7 +178,7 @@ End Sub
' ============================================================ ' ============================================================
' Z2 Cache ' Z2 Cache
' ============================================================ ' ============================================================
Public Sub RefreshZ2Cache() Private Sub RefreshZ2Cache()
Set z2Cache = Nothing Set z2Cache = Nothing
On Error GoTo RefreshError On Error GoTo RefreshError
@@ -197,7 +198,7 @@ End Sub
' ============================================================ ' ============================================================
' Z3 Cache ' Z3 Cache
' ============================================================ ' ============================================================
Public Sub RefreshZ3Cache() Private Sub RefreshZ3Cache()
Set z3Cache = Nothing Set z3Cache = Nothing
On Error GoTo RefreshError On Error GoTo RefreshError
@@ -217,7 +218,7 @@ End Sub
' ============================================================ ' ============================================================
' z4Cache ' z4Cache
' ============================================================ ' ============================================================
Public Sub RefreshZ4Cache() Private Sub RefreshZ4Cache()
On Error GoTo RefreshError On Error GoTo RefreshError
Set z4Cache = LoadLookup("Z4", keyCol:=3, valueCols:=Array(4), startRow:=7) Set z4Cache = LoadLookup("Z4", keyCol:=3, valueCols:=Array(4), startRow:=7)
On Error GoTo 0 On Error GoTo 0
@@ -235,7 +236,7 @@ End Sub
' ============================================================ ' ============================================================
' O1 Cache ' O1 Cache
' ============================================================ ' ============================================================
Public Sub RefreshO1Cache() Private Sub RefreshO1Cache()
Set o1Cache = Nothing Set o1Cache = Nothing
Set o1Cache = CreateObject("Scripting.Dictionary") Set o1Cache = CreateObject("Scripting.Dictionary")
@@ -287,7 +288,7 @@ End Sub
' ============================================================ ' ============================================================
' O2 Cache ' O2 Cache
' ============================================================ ' ============================================================
Public Sub RefreshO2Cache() Private Sub RefreshO2Cache()
Set o2Cache = Nothing Set o2Cache = Nothing
On Error GoTo RefreshError On Error GoTo RefreshError
@@ -307,7 +308,7 @@ End Sub
' ============================================================ ' ============================================================
' tokubetuList ' tokubetuList
' ============================================================ ' ============================================================
Public Sub GetTokubetu() Private Sub RefreshTokubetu()
On Error GoTo RefreshError On Error GoTo RefreshError
Set tokubetuList = LoadLookup("Enum", keyCol:=1, valueCols:=Array(1), startRow:=3) Set tokubetuList = LoadLookup("Enum", keyCol:=1, valueCols:=Array(1), startRow:=3)
On Error GoTo 0 On Error GoTo 0
@@ -325,7 +326,7 @@ End Sub
' ============================================================ ' ============================================================
' oufukuList ' oufukuList
' ============================================================ ' ============================================================
Public Sub GetOufukuList() Private Sub RefreshOufukuList()
On Error GoTo RefreshError On Error GoTo RefreshError
Set oufukuList = LoadLookup("Enum", keyCol:=6, valueCols:=Array(7), startRow:=3) Set oufukuList = LoadLookup("Enum", keyCol:=6, valueCols:=Array(7), startRow:=3)
On Error GoTo 0 On Error GoTo 0
@@ -343,7 +344,7 @@ End Sub
' ============================================================ ' ============================================================
' koutaiList ' koutaiList
' ============================================================ ' ============================================================
Public Sub GetKoutaiList() Private Sub RefreshKoutaiList()
On Error GoTo RefreshError On Error GoTo RefreshError
Set koutaiList = LoadLookup("Enum", keyCol:=9, valueCols:=Array(10), startRow:=3) Set koutaiList = LoadLookup("Enum", keyCol:=9, valueCols:=Array(10), startRow:=3)
On Error GoTo 0 On Error GoTo 0
@@ -361,7 +362,7 @@ End Sub
' ============================================================ ' ============================================================
' higaitouList ' higaitouList
' ============================================================ ' ============================================================
Public Sub GetHigaitouList() Private Sub RefreshHigaitouList()
On Error GoTo RefreshError On Error GoTo RefreshError
Set higaitouList = LoadLookup("Enum", keyCol:=12, valueCols:=Array(13), startRow:=3) Set higaitouList = LoadLookup("Enum", keyCol:=12, valueCols:=Array(13), startRow:=3)
On Error GoTo 0 On Error GoTo 0
@@ -376,8 +377,221 @@ RefreshError:
Err.Raise 1001, "GetHigaitouList", "Failed to load Enum lookup cache: " & Err.Description Err.Raise 1001, "GetHigaitouList", "Failed to load Enum lookup cache: " & Err.Description
End Sub End Sub
' sheetName : [START_COL, END_COL, ERROR_COL, START_ROW, HEADER_ROW, RefaushCacheName] Private Sub RefreshSheetDict()
Public Sub RefreshDataRangeDict() Set sheetConfDict = CreateObject("Scripting.Dictionary")
Set dataRangeDict = CreateObject("Scripting.Dictionary") Dim sheetConf As Object
dataRangeDict("M1") = Array("C", "N", "O", 7, 5, "RefreshM1Cache")
' 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 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 ' Create transport (T) dropdown from Z1 cache
Public Function BuildTransportList() Public Function BuildTransportList()
If z1Cache Is Nothing Then Call RefreshZ1Cache Dim z1Cache As Object: Set z1Cache = GetZ1Cache()
Dim dropdownList As String Dim dropdownList As String
Dim key As Variant Dim key As Variant
@@ -36,7 +36,7 @@ End Function
' Create todoke (G) dropdown ' Create todoke (G) dropdown
Public Function BuildTodokeList() Public Function BuildTodokeList()
If z4Cache Is Nothing Then Call RefreshZ4Cache Dim z4Cache As Object: Set z4Cache = GetZ4Cache()
Dim dropdownList As String Dim dropdownList As String
Dim key As Variant Dim key As Variant
@@ -54,7 +54,7 @@ End Function
' Create oufuku (M) dropdown ' Create oufuku (M) dropdown
Public Function BuildOufukuList() Public Function BuildOufukuList()
If oufukuList Is Nothing Then Call GetOufukuList Dim oufukuList As Object: Set oufukuList = GetOufukuList()
Dim dropdownList As String Dim dropdownList As String
Dim key As Variant Dim key As Variant
@@ -72,7 +72,7 @@ End Function
' Create Koutai (N) dropdown ' Create Koutai (N) dropdown
Public Function BuildKoutaiList() Public Function BuildKoutaiList()
If koutaiList Is Nothing Then Call GetKoutaiList Dim koutaiList As Object: Set koutaiList = GetKoutaiList()
Dim dropdownList As String Dim dropdownList As String
Dim key As Variant Dim key As Variant
@@ -90,7 +90,7 @@ End Function
' Create Kettei (AU) dropdown ' Create Kettei (AU) dropdown
Public Function BuildKetteiList() Public Function BuildKetteiList()
If z2Cache Is Nothing Then Call RefreshZ2Cache Dim z2Cache As Object: Set z2Cache = GetZ2Cache()
Dim dropdownList As String Dim dropdownList As String
Dim key As Variant Dim key As Variant
@@ -108,7 +108,7 @@ End Function
' Create Higaitou (AW) dropdown ' Create Higaitou (AW) dropdown
Public Function BuildHigaitouList() Public Function BuildHigaitouList()
If higaitouList Is Nothing Then Call GetHigaitouList Dim higaitouList As Object: Set higaitouList = GetHigaitouList()
Dim dropdownList As String Dim dropdownList As String
Dim key As Variant Dim key As Variant
@@ -126,7 +126,7 @@ End Function
' Create MonthAmountKbn (AX) dropdown ' Create MonthAmountKbn (AX) dropdown
Public Function BuildMonthAmountKbnList() Public Function BuildMonthAmountKbnList()
If z3Cache Is Nothing Then Call RefreshZ3Cache Dim z3Cache As Object: Set z3Cache = GetZ3Cache()
Dim dropdownList As String Dim dropdownList As String
Dim key As Variant Dim key As Variant
@@ -144,7 +144,7 @@ End Function
' Create Kanshoku (BC) dropdown ' Create Kanshoku (BC) dropdown
Public Function BuildKanshokuList() Public Function BuildKanshokuList()
If o2Cache Is Nothing Then Call RefreshO2Cache Dim o2Cache As Object: Set o2Cache = GetO2Cache()
Dim dropdownList As String Dim dropdownList As String
Dim key As Variant Dim key As Variant

61
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 intersectRng Is Nothing Then Exit Sub
If Target.Row < 7 Then Exit Sub If Target.Row < 7 Then Exit Sub
Dim idx As Long
Application.EnableEvents = False Application.EnableEvents = False
On Error GoTo Finally On Error GoTo Finally
@@ -139,7 +140,6 @@ Private Sub Worksheet_Change(ByVal Target As Range)
End If End If
' === Transport column changes (T, AA, AH, AO) === ' === Transport column changes (T, AA, AH, AO) ===
Dim idx As Long
idx = GetIdx(Target.Column, KUKAN_TRANSPORT_COLS) idx = GetIdx(Target.Column, KUKAN_TRANSPORT_COLS)
If idx >= 0 Then If idx >= 0 Then
Dim cellT As Range Dim cellT As Range
@@ -260,7 +260,7 @@ End Sub
' Fill kukan info from M1 cache (key: kukan code, value: 7 elements) ' Fill kukan info from M1 cache (key: kukan code, value: 7 elements)
Private Sub FillKukanFromM1(ByVal rowNum As Long, ByVal idx As Long) 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 codeCol As Long: codeCol = KUKAN_CODE_COLS(idx)
Dim transportCol As Long: transportCol = KUKAN_TRANSPORT_COLS(idx) Dim transportCol As Long: transportCol = KUKAN_TRANSPORT_COLS(idx)
@@ -293,7 +293,7 @@ End Sub
' Fill address dropdown from O1 cache ' Fill address dropdown from O1 cache
Private Sub FillAddressFromO1(ByVal rowNum As Long) 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 Dim empNo As String
empNo = Trim(Me.Cells(rowNum, 3).Value) empNo = Trim(Me.Cells(rowNum, 3).Value)
@@ -329,7 +329,7 @@ End Sub
' Create station (利用区間発) dropdown from M1_KukanD cache ' Create station (利用区間発) dropdown from M1_KukanD cache
Private Sub CreateFromStationDropdown(ByVal rowNum As Long, ByVal transportCol As Long, ByVal stationCol As Long) 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) Dim transport As String: transport = GetCode(Me.Cells(rowNum, transportCol).Value)
If transport = "" Then Exit Sub If transport = "" Then Exit Sub
@@ -361,7 +361,7 @@ End Sub
' Create destination (利用区間着) dropdown from M1_KukanD cache ' Create destination (利用区間着) dropdown from M1_KukanD cache
' Structure: { D: { F: [G] } } ' Structure: { D: { F: [G] } }
Private Sub CreateToStationDropdown(ByVal rowNum As Long, ByVal transportCol As Long, ByVal stationFromCol As Long, ByVal stationToCol As Long) 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 transport As String: transport = GetCode(Me.Cells(rowNum, transportCol).Value)
Dim stationFrom As String: stationFrom = GetCode(Me.Cells(rowNum, stationFromCol).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) ' 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 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 transportKbn As String: transportKbn = GetCode(Trim(Me.Cells(rowNum, transportCol).Value))
Dim stationFrom As String: stationFrom = Trim(Me.Cells(rowNum, stationFromCol).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 ' 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) 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 kukanCode As String: kukanCode = Trim(Me.Cells(rowNum, kukanCodeCol).Value)
Dim kanshu As String: kanshu = Trim(Me.Cells(rowNum, kanshuCol).Value) Dim kanshu As String: kanshu = Trim(Me.Cells(rowNum, kanshuCol).Value)
@@ -465,33 +465,18 @@ Private Sub ClearRowData(ByVal rowNum As Long)
Me.Cells(rowNum, ERROR_COL).ClearContents Me.Cells(rowNum, ERROR_COL).ClearContents
End Sub 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 ' Validation logic
Private Private Sub validate(ByVal rowNum As Long) Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
Set ws = Me
' Clear background color Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Me.Range(Me.Cells(rowNum, START_COL), Me.Cells(rowNum, END_COL)).Interior.Color = vbWhite 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 ' Required columns: C-G, K-N, AW
Dim requiredCols As Variant Dim requiredCols As Variant
@@ -507,15 +492,3 @@ Private Private Sub validate(ByVal rowNum As Long)
Me.Cells(rowNum, ERROR_COL).ClearContents Me.Cells(rowNum, ERROR_COL).ClearContents
End Sub 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 Name: Master_Kukan
' Module Desc: M1 Kukan master data management (import/export/validate) ' Module Desc: M1 Kukan master data management (import/export/validate)
' Module Methods: ' Module Methods:
' - Import ' - CreateEnumDropdown
' - Export
' - validateButton_Click
' - SortData
' - ToggleAutoFilter
' - Worksheet_Change ' - Worksheet_Change
' - ValidateRow ' - Validate
' - FillValidationDropdown
' - ValidateAllRows
' ============================================================ ' ============================================================
' ====== 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 ' Create dropdown for L column
Private Sub CreateEnumDropdown(ByVal rowNum As Long) 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 ' Build dropdown list from tokubetuList
Dim dropdownList As String Dim dropdownList As String
dropdownList = "" dropdownList = ""
@@ -49,7 +34,7 @@ Private Sub CreateEnumDropdown(ByVal rowNum As Long)
End Sub End Sub
'
Private Sub Worksheet_Change(ByVal Target As Range) Private Sub Worksheet_Change(ByVal Target As Range)
' === Column C changes: Create L column dropdown === ' === Column C changes: Create L column dropdown ===
If Target.Column = 3 And Target.Row >= 7 Then 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 === ' === Column D changes: Fill E column ===
If Target.Column = 4 And Target.Row >= 7 Then 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 Dim cellD As Range
For Each cellD In Target For Each cellD In Target
@@ -85,57 +70,23 @@ Private Sub Worksheet_Change(ByVal Target As Range)
End If End If
End Sub End Sub
Sub Import(wsTarget As Worksheet) Private Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
' === Step 1: Select CSV file ===
Dim filePath As String: filePath = SelectCSVFile()
If filePath = "" Then Exit Sub
' === Step 2: Read CSV with Shift-JIS (using common function) === Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
On Error GoTo ImportError Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
Dim csvData As Variant: csvData = ReadCSVAs2DArrayStrict(filePath, 12, "shift_jis", True)
On Error GoTo 0
If UBound(csvData, 1) < 1 Then Dim startCol As String: startCol = sheetConf("StartCol")
MsgBox "No data in CSV.", vbExclamation Dim endCol As String: endCol = sheetConf("EndCol")
Exit Sub Dim errorCol As String: errorCol = sheetConf("ErrorCol")
End If
' === Step 3:Clear all data rows before import === Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
Application.EnableEvents = False
Call ClearDataRows(wsTarget, START_COL, END_COL, 7)
Application.EnableEvents = True
' === 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))
clearRange.Interior.Color = vbWhite clearRange.Interior.Color = vbWhite
' Check column required ' Check column required
Dim colLetter As Variant Dim colLetter As Variant
For Each colLetter In Array("C", "D", "E", "F", "G", "I", "L") For Each colLetter In Array("C", "D", "E", "F", "G", "I", "L")
If Trim(ws.Range(colLetter & rowNum).Value) = "" Then 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) ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If 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") For Each colLetter In Array("H", "I", "J", "N")
Dim val As String: val = Trim(ws.Range(colLetter & rowNum).Value) Dim val As String: val = Trim(ws.Range(colLetter & rowNum).Value)
If val <> "" And Not IsNumeric(val) Then 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) ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If 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) 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 Not foundCell Is Nothing Then
If foundCell.Row <> rowNum 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) ws.Range("C" & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
End If End If
' Check D and E column in the cache ' 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 dValue As String: dValue = Trim(ws.Range("D" & rowNum).Value)
Dim eValue As String: eValue = Trim(ws.Range("E" & rowNum).Value) Dim eValue As String: eValue = Trim(ws.Range("E" & rowNum).Value)
If Not z1Cache.Exists(dValue) Then 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) ws.Range("D" & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
Else Else
Dim valueArray As Variant Dim valueArray As Variant
valueArray = z1Cache(dValue) valueArray = z1Cache(dValue)
If Not IsArray(valueArray) Or UBound(valueArray) < 0 Then 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 Exit Sub
End If End If
@@ -185,121 +136,22 @@ Private Sub validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
expectedEValue = Trim(CStr(valueArray(0))) expectedEValue = Trim(CStr(valueArray(0)))
If eValue <> expectedEValue Then 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) ws.Range("E" & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
End If End If
' Check L column in the tokubetuList ' 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) Dim lValue As String: lValue = Trim(ws.Range("L" & rowNum).Value)
If Not tokubetuList.Exists(lValue) Then 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) ws.Range("L" & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
' Validation passed - clear error ' 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 End Sub

185
src/sheet/M2.cls
View File

@@ -2,28 +2,11 @@
' Module Name: Master_Kukan_detail ' Module Name: Master_Kukan_detail
' Module Desc: M2 Kukan detail master data management ' Module Desc: M2 Kukan detail master data management
' Module Methods: ' Module Methods:
' - Import
' - Export
' - validateButton_Click
' - SortData
' - ToggleAutoFilter
' - Worksheet_Change ' - Worksheet_Change
' - ValidateRow ' - FillFromM1
' - FillValidationDropdown ' - validateButton_Click
' - ValidateAllRows ' - 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) Private Sub Worksheet_Change(ByVal Target As Range)
' === Fill D, E when C column changes === ' === Fill D, E when C column changes ===
If Target.Column = 3 And Target.Row >= 7 Then If Target.Column = 3 And Target.Row >= 7 Then
@@ -38,10 +21,10 @@ Private Sub Worksheet_Change(ByVal Target As Range)
End If End If
End Sub 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 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) Dim cValue As String: cValue = Trim(ws.Range("C" & rowNum).Value)
' Fill D, E, F, G, H columns from M1 cache ' 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)) ws.Cells(rowNum, 8).Value = Trim(cacheVal(6))
End Sub 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 ' Clear from D column onwards
ws.Range(ws.Cells(rowNum, 4), ws.Cells(rowNum, 15)).ClearContents ws.Range(ws.Cells(rowNum, 4), ws.Cells(rowNum, 15)).ClearContents
ws.Cells(rowNum, 6).Validation.Delete ws.Cells(rowNum, 6).Validation.Delete
ws.Cells(rowNum, 19).ClearContents ' Q column error info ws.Cells(rowNum, 19).ClearContents ' Q column error info
End Sub End Sub
Private Sub Import() Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
' === Step 1: Select CSV file ===
Dim filePath As String: filePath = SelectCSVFile()
If filePath = "" Then Exit Sub
' === Step 2: Read CSV with Shift-JIS (using common function) === Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
On Error GoTo ImportError Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
Dim csvData As Variant: csvData = ReadCSVAs2DArrayStrict(filePath, 11, "shift_jis", True)
On Error GoTo 0
If UBound(csvData, 1) < 1 Then Dim startCol As String: startCol = sheetConf("StartCol")
MsgBox "No data in CSV.", vbExclamation Dim endCol As String: endCol = sheetConf("EndCol")
Exit Sub Dim errorCol As String: errorCol = sheetConf("ErrorCol")
End If
' === Step 3:Clear all data rows before import === Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
Application.EnableEvents = False
Dim wsTarget As Worksheet: Set wsTarget = Me
Call ClearDataRows(wsTarget, START_COL, ERROR_COL, 7)
Application.EnableEvents = True
' === 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))
clearRange.Interior.Color = vbWhite clearRange.Interior.Color = vbWhite
' Check C column in the cache ' 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) Dim cValue As String: cValue = Trim(ws.Range("C" & rowNum).Value)
If cValue <> "" AND Not m1Cache.Exists(cValue) Then 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) ws.Range("C" & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
@@ -141,7 +88,7 @@ Private Sub validate(ByVal rowNum As Long, ByVal lastDataRow As Long)
Dim colLetter As Variant Dim colLetter As Variant
For Each colLetter In Array("C", "I", "J", "K") For Each colLetter In Array("C", "I", "J", "K")
If Trim(ws.Range(colLetter & rowNum).Value) = "" Then 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) ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
@@ -153,7 +100,7 @@ Private Sub validate(ByVal rowNum As Long, ByVal lastDataRow As Long)
For Each col In numericCols For Each col In numericCols
Dim val As String: val = Trim(ws.Range(col & rowNum).Value & "") Dim val As String: val = Trim(ws.Range(col & rowNum).Value & "")
If val <> "" And Not IsNumeric(val) Then 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) ws.Range(col & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If 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 kenshuKbn As Variant: kenshuKbn = Array("1", "2", "3")
Dim iValue As String: iValue = Trim(ws.Range("I" & rowNum).Value) Dim iValue As String: iValue = Trim(ws.Range("I" & rowNum).Value)
If UBound(Filter(kenshuKbn, iValue)) = -1 Then 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) ws.Range("I" & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
End Sub 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 Name: Master_address
' Module Desc: O1 address master data management ' Module Desc: O1 address master data management
' Module Methods: ' 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 Name: Master_507
' Module Desc: O2 master data management (507) ' Module Desc: O2 master data management (507)
' Module Methods: ' Module Methods:
' - Import
' - Export
' - SortData
' - ToggleAutoFilter
' ============================================================ ' ============================================================
' ====== (507) ======= ' ====== (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 Name: Master_222
' Module Desc: Z1 master data management (222) ' Module Desc: Z1 master data management (222)
' Module Methods: ' Module Methods:
' - Import ' - Validate
' - Export
' - SortData
' - ToggleAutoFilter
' ============================================================ ' ============================================================
' ====== (222) ======= '
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
' ====== Constants ====== Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Const START_COL As Long = 3 Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
Const END_COL As Long = 9
Const ERROR_COL As Long = 2
' ====== Function ====== Dim startCol As String: startCol = sheetConf("StartCol")
Private Sub Import() Dim endCol As String: endCol = sheetConf("EndCol")
Call Generic_Master_Import(Me, 7) Dim errorCol As String: errorCol = sheetConf("ErrorCol")
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)
' clear C~I columns background color ' clear C~I columns background color
Dim clearRange As Range Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
Set clearRange = ws.Range(ws.Cells(rowNum, START_COL), ws.Cells(rowNum, END_COL))
clearRange.Interior.Color = vbWhite clearRange.Interior.Color = vbWhite
Dim cValue As String: cValue = Trim(ws.Cells(rowNum, 3).Value)
If cValue = "" Then 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) ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
If Len(cValue) <> 3 Then 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) ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
@@ -69,7 +36,7 @@ Private Sub validate(ByVal rowNum As Long)
For i = 1 To 3 For i = 1 To 3
ch = Mid(cValue, i, 1) 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 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) ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
@@ -78,12 +45,12 @@ Private Sub validate(ByVal rowNum As Long)
Dim dValue As String Dim dValue As String
dValue = Trim(ws.Cells(rowNum, 4).Value) dValue = Trim(ws.Cells(rowNum, 4).Value)
If dValue = "" Then 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) ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
If Len(dValue) > 80 Then 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) ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
@@ -91,12 +58,12 @@ Private Sub validate(ByVal rowNum As Long)
Dim eValue As String Dim eValue As String
eValue = Trim(ws.Cells(rowNum, 5).Value) eValue = Trim(ws.Cells(rowNum, 5).Value)
If eValue = "" Then 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) ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
If Len(eValue) > 80 Then 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) ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
@@ -104,7 +71,7 @@ Private Sub validate(ByVal rowNum As Long)
Dim fValue As String Dim fValue As String
fValue = Trim(ws.Cells(rowNum, 6).Value) fValue = Trim(ws.Cells(rowNum, 6).Value)
If fValue <> "" And Len(fValue) > 80 Then 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) ws.Cells(rowNum, 6).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
@@ -112,7 +79,7 @@ Private Sub validate(ByVal rowNum As Long)
Dim gValue As String Dim gValue As String
gValue = Trim(ws.Cells(rowNum, 7).Value) gValue = Trim(ws.Cells(rowNum, 7).Value)
If gValue <> "" And Len(gValue) > 80 Then 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) ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
@@ -121,12 +88,12 @@ Private Sub validate(ByVal rowNum As Long)
hValue = Trim(ws.Cells(rowNum, 8).Value) hValue = Trim(ws.Cells(rowNum, 8).Value)
If hValue <> "" Then If hValue <> "" Then
If Len(hValue) <> 1 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) ws.Cells(rowNum, 8).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
If hValue <> "0" And hValue <> "1" Then 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) ws.Cells(rowNum, 8).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
@@ -135,47 +102,10 @@ Private Sub validate(ByVal rowNum As Long)
Dim iValue As String Dim iValue As String
iValue = Trim(ws.Cells(rowNum, 9).Value) iValue = Trim(ws.Cells(rowNum, 9).Value)
If iValue <> "" And Len(iValue) > 80 Then 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) ws.Cells(rowNum, 9).Interior.Color = RGB(255, 0, 0)
Exit Sub 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 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 End Sub

112
src/sheet/Z2.cls
View File

@@ -2,64 +2,31 @@
' Module Name: Master_223 ' Module Name: Master_223
' Module Desc: Z2 master data management (223) ' Module Desc: Z2 master data management (223)
' Module Methods: ' Module Methods:
' - Import ' - Validate
' - Export
' - SortData
' - ToggleAutoFilter
' ============================================================ ' ============================================================
' ====== (223) ======= '
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
' ====== Constants ====== Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Const START_COL As Long = 3 Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
Const END_COL As Long = 7
Const ERROR_COL As Long = 2
' ====== Function ====== Dim startCol As String: startCol = sheetConf("StartCol")
Private Sub Import() Dim endCol As String: endCol = sheetConf("EndCol")
Call Generic_Master_Import(Me, 5) Dim errorCol As String: errorCol = sheetConf("ErrorCol")
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, 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 ' clear C~I columns background color
Dim clearRange As Range Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
Set clearRange = ws.Range(ws.Cells(rowNum, START_COL), ws.Cells(rowNum, END_COL))
clearRange.Interior.Color = vbWhite clearRange.Interior.Color = vbWhite
Dim cValue As String: cValue = Trim(ws.Cells(rowNum, 3).Value)
If cValue = "" Then 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) ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
If Len(cValue) <> 3 Then 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) ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
@@ -69,7 +36,7 @@ Private Sub validate(ByVal rowNum As Long)
For i = 1 To 3 For i = 1 To 3
ch = Mid(cValue, i, 1) 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 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) ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
@@ -78,12 +45,12 @@ Private Sub validate(ByVal rowNum As Long)
Dim dValue As String Dim dValue As String
dValue = Trim(ws.Cells(rowNum, 4).Value) dValue = Trim(ws.Cells(rowNum, 4).Value)
If dValue = "" Then 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) ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
If Len(dValue) > 80 Then 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) ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
@@ -91,12 +58,12 @@ Private Sub validate(ByVal rowNum As Long)
Dim eValue As String Dim eValue As String
eValue = Trim(ws.Cells(rowNum, 5).Value) eValue = Trim(ws.Cells(rowNum, 5).Value)
If eValue = "" Then 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) ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
If Len(eValue) > 80 Then 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) ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
@@ -104,7 +71,7 @@ Private Sub validate(ByVal rowNum As Long)
Dim fValue As String Dim fValue As String
fValue = Trim(ws.Cells(rowNum, 6).Value) fValue = Trim(ws.Cells(rowNum, 6).Value)
If fValue <> "" And Len(fValue) > 80 Then 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) ws.Cells(rowNum, 6).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
@@ -113,53 +80,16 @@ Private Sub validate(ByVal rowNum As Long)
hValue = Trim(ws.Cells(rowNum, 7).Value) hValue = Trim(ws.Cells(rowNum, 7).Value)
If hValue <> "" Then If hValue <> "" Then
If Len(hValue) <> 1 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) ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
If hValue <> "0" And hValue <> "1" Then 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) ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
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 End Sub

115
src/sheet/Z3.cls
View File

@@ -2,64 +2,30 @@
' Module Name: Master_Z3_224 ' Module Name: Master_Z3_224
' Module Desc: Z3 master data management (224) ' Module Desc: Z3 master data management (224)
' Module Methods: ' Module Methods:
' - Z3_Import ' - Validate
' - Z3_Export
' - Z3_SortDataRowsByC
' - Z3_ToggleAutoFilter
' ============================================================ ' ============================================================
' ====== (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 ====== Dim startCol As String: startCol = sheetConf("StartCol")
Const START_COL As Long = 3 Dim endCol As String: endCol = sheetConf("EndCol")
Const END_COL As Long = 8 Dim errorCol As String: errorCol = sheetConf("ErrorCol")
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)
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 ' clear C~I columns background color
Dim clearRange As Range Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
Set clearRange = ws.Range(ws.Cells(rowNum, START_COL), ws.Cells(rowNum, END_COL))
clearRange.Interior.Color = vbWhite clearRange.Interior.Color = vbWhite
Dim cValue As String: cValue = Trim(ws.Cells(rowNum, 3).Value)
If cValue = "" Then 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) ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
If Len(cValue) <> 3 Then 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) ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
@@ -69,7 +35,7 @@ Private Sub validate(ByVal rowNum As Long)
For i = 1 To 3 For i = 1 To 3
ch = Mid(cValue, i, 1) 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 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) ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
@@ -78,12 +44,12 @@ Private Sub validate(ByVal rowNum As Long)
Dim dValue As String Dim dValue As String
dValue = Trim(ws.Cells(rowNum, 4).Value) dValue = Trim(ws.Cells(rowNum, 4).Value)
If dValue = "" Then 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) ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
If Len(dValue) > 80 Then 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) ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
@@ -91,12 +57,12 @@ Private Sub validate(ByVal rowNum As Long)
Dim eValue As String Dim eValue As String
eValue = Trim(ws.Cells(rowNum, 5).Value) eValue = Trim(ws.Cells(rowNum, 5).Value)
If eValue = "" Then 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) ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
If Len(eValue) > 80 Then 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) ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
@@ -104,7 +70,7 @@ Private Sub validate(ByVal rowNum As Long)
Dim fValue As String Dim fValue As String
fValue = Trim(ws.Cells(rowNum, 6).Value) fValue = Trim(ws.Cells(rowNum, 6).Value)
If fValue <> "" And Len(fValue) > 80 Then 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) ws.Cells(rowNum, 6).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
@@ -113,12 +79,12 @@ Private Sub validate(ByVal rowNum As Long)
hValue = Trim(ws.Cells(rowNum, 7).Value) hValue = Trim(ws.Cells(rowNum, 7).Value)
If hValue <> "" Then If hValue <> "" Then
If Len(hValue) <> 1 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) ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
If hValue <> "0" And hValue <> "1" Then 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) ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
@@ -127,47 +93,10 @@ Private Sub validate(ByVal rowNum As Long)
Dim iValue As String Dim iValue As String
iValue = Trim(ws.Cells(rowNum, 8).Value) iValue = Trim(ws.Cells(rowNum, 8).Value)
If iValue <> "" And Len(iValue) > 80 Then 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) ws.Cells(rowNum, 8).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If 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 End Sub

115
src/sheet/Z4.cls
View File

@@ -2,64 +2,30 @@
' Module Name: Master_Z4_220 ' Module Name: Master_Z4_220
' Module Desc: Z4 master data management (220) ' Module Desc: Z4 master data management (220)
' Module Methods: ' Module Methods:
' - Z4_Import ' - Validate
' - Z4_Export
' - Z4_SortDataRowsByC
' - Z4_ToggleAutoFilter
' ============================================================ ' ============================================================
' ====== (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 ====== Dim startCol As String: startCol = sheetConf("StartCol")
Const START_COL As Long = 3 Dim endCol As String: endCol = sheetConf("EndCol")
Const END_COL As Long = 9 Dim errorCol As String: errorCol = sheetConf("ErrorCol")
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)
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 ' clear C~I columns background color
Dim clearRange As Range Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
Set clearRange = ws.Range(ws.Cells(rowNum, START_COL), ws.Cells(rowNum, END_COL))
clearRange.Interior.Color = vbWhite clearRange.Interior.Color = vbWhite
Dim cValue As String: cValue = Trim(ws.Cells(rowNum, 3).Value)
If cValue = "" Then 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) ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
If Len(cValue) <> 3 Then 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) ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
@@ -69,7 +35,7 @@ Private Sub validate(ByVal rowNum As Long)
For i = 1 To 3 For i = 1 To 3
ch = Mid(cValue, i, 1) 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 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) ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
@@ -78,12 +44,12 @@ Private Sub validate(ByVal rowNum As Long)
Dim dValue As String Dim dValue As String
dValue = Trim(ws.Cells(rowNum, 4).Value) dValue = Trim(ws.Cells(rowNum, 4).Value)
If dValue = "" Then 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) ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
If Len(dValue) > 80 Then 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) ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
@@ -91,12 +57,12 @@ Private Sub validate(ByVal rowNum As Long)
Dim eValue As String Dim eValue As String
eValue = Trim(ws.Cells(rowNum, 5).Value) eValue = Trim(ws.Cells(rowNum, 5).Value)
If eValue = "" Then 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) ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
If Len(eValue) > 80 Then 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) ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
@@ -104,7 +70,7 @@ Private Sub validate(ByVal rowNum As Long)
Dim fValue As String Dim fValue As String
fValue = Trim(ws.Cells(rowNum, 6).Value) fValue = Trim(ws.Cells(rowNum, 6).Value)
If fValue <> "" And Len(fValue) > 80 Then 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) ws.Cells(rowNum, 6).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
@@ -113,12 +79,12 @@ Private Sub validate(ByVal rowNum As Long)
hValue = Trim(ws.Cells(rowNum, 7).Value) hValue = Trim(ws.Cells(rowNum, 7).Value)
If hValue <> "" Then If hValue <> "" Then
If Len(hValue) <> 1 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) ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
If hValue <> "0" And hValue <> "1" Then 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) ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0)
Exit Sub Exit Sub
End If End If
@@ -127,47 +93,10 @@ Private Sub validate(ByVal rowNum As Long)
Dim iValue As String Dim iValue As String
iValue = Trim(ws.Cells(rowNum, 8).Value) iValue = Trim(ws.Cells(rowNum, 8).Value)
If iValue <> "" And Len(iValue) > 80 Then 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) ws.Cells(rowNum, 8).Interior.Color = RGB(255, 0, 0)
Exit Sub 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 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 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.