diff --git a/README.md b/README.md deleted file mode 100644 index c4f2b72..0000000 --- a/README.md +++ /dev/null @@ -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) -``` \ No newline at end of file diff --git a/src/init_module/Import_modules.bas b/src/init_module/Import_modules.bas index ecf6c45..71db349 100644 --- a/src/init_module/Import_modules.bas +++ b/src/init_module/Import_modules.bas @@ -5,8 +5,9 @@ Sub ImportModulesAndSheets_Safe() Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") - Const MODULE_PATH As String = "D:\Project\upds7\vba\src\module" - Const SHEET_PATH As String = "D:\Project\upds7\vba\src\sheet" + Const PROJECT_PATH As String = "E:\AI\project\updsv7\vba\" + Const MODULE_PATH As String = PROJECT_PATH & "src\module" + Const SHEET_PATH As String = PROJECT_PATH & "src\sheet" ' --- Phase 1: Validation --- Debug.Print "[LOG] Starting validation phase..." diff --git a/src/module/Common_Button.bas b/src/module/Common_Button.bas index 32a5874..e270f3f 100644 --- a/src/module/Common_Button.bas +++ b/src/module/Common_Button.bas @@ -4,7 +4,7 @@ Option Explicit ' Module Name: Common_Button ' Module Desc: Common_Button ' Module Methods: -' - Import +' - CSV_Import_Button ' ============================================================ Sub CSV_Import_Button() DO_CSV_Import ActiveSheet @@ -15,41 +15,80 @@ Sub Validation_Button() End Sub Sub CSV_Export_Button() - CSV_Import ActiveSheet + DO_CSV_Export ActiveSheet End Sub -Sub Do_Sort_Button() +Sub Sort_Button() Do_Sort ActiveSheet End Sub -Sub Do_Filter_Button() +Sub Filter_Button() Do_Filter ActiveSheet End Sub -Sub Do_Fit_Button() +Sub Fit_Button() Do_Fit ActiveSheet End Sub Private Sub DO_CSV_Import(ws As Excel.Worksheet) - Dim macroName As String - macroName = ws.CodeName & ".Import" - - If Not ProcedureExists(ws.CodeName, "Import") Then - MsgBox "worksheet """ & ws.name & """ unimplement methods", vbExclamation - Exit Sub - End If - - On Error GoTo ErrorHandler - Application.Run macroName, ws - Exit Sub + On Error GoTo ImportError -ErrorHandler: - MsgBox "error" & Err.Description, vbCritical + ' Step 1: get csv encoding + Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig() + Dim cfg As Object: Set cfg = sheetConfDict(ws.CodeName) + Dim expectedColumnCount As Long: expectedColumnCount = cfg("ExpectedColumnCount") + + ' Step 2: Select CSV file + Dim filePath As String: filePath = SelectCSVFile() + If filePath = "" Then Exit Sub + + ' Step 3: Read CSV and return 2D array + Dim csvData As Variant: csvData = ReadCSVAs2DArrayStrict(filePath, expectedColumnCount, cfg("CSV_Encoding"), cfg("HasHeader")) + + If Not IsArray(csvData) Then + MsgBox "No valid data returned from CSV.", vbExclamation + GoTo FinallyExit + End If + + If UBound(csvData, 1) < 1 Then + MsgBox "No data in CSV.", vbExclamation + GoTo FinallyExit + End If + + ' === Step 3:Clear all data rows before import === + Application.ScreenUpdating = False + Application.EnableEvents = False + Call ClearDataRows(ws) + + ' === Step 4: Write CSV data to worksheet === + Dim colLetters As Variant: colLetters = cfg("HeaderColumns") + Dim writeRow As Long: writeRow = cfg("StartRow") + Dim i As Long + For i = LBound(csvData, 1) To UBound(csvData, 1) + Dim j As Long + For j = 0 To expectedColumnCount - 1 + ws.Cells(writeRow, ws.Range(colLetters(j) & "1").Column).Value = CleanCSVField(CStr(csvData(i, j + 1))) + Next j + writeRow = writeRow + 1 + Next i + + MsgBox writeRow - cfg("StartRow") & " rows imported.", vbInformation + GoTo FinallyExit + +ImportError: + MsgBox "CSV import failed: " & Err.Description, vbExclamation + +FinallyExit: + Application.EnableEvents = True + Application.ScreenUpdating = True End Sub +' Private Sub Do_Validation(ws As Excel.Worksheet) - If dataRangeDict Is Nothing Then Call RefreshDataRangeDict - Dim dataRange As Variant: dataRange = dataRangeDict(ws.CodeName) + On Error GoTo ErrorHandler + + Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig() + Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName) ' step1. confirm Validate Sub Dim validate As String @@ -60,46 +99,193 @@ Private Sub Do_Validation(ws As Excel.Worksheet) Exit Sub End If - ' step2. confirm data range - Dim lastDataRow As Long, r As Long, errorCount As Long - lastDataRow = GetLastDataRowInRange(ws) + Dim errorCount As Long + Dim isValid As Boolean: isValid = RunValidationSilent(ws, errorCount) + + If errorCount = -1 Then + MsgBox "worksheet """ & ws.Name & """ unimplement methods", vbExclamation + ElseIf errorCount = -2 Then + MsgBox "Validation error occurred.", vbCritical + ElseIf errorCount > 0 Then + MsgBox "Validation complete. Errors: " & errorCount, vbInformation + Else + 'There is no error + Dim cacheMethodName As String: cacheMethodName = Trim(sheetConf("RefreshCacheName")) + If cacheMethodName <> "" Then + Application.Run cacheMethodName + End If + MsgBox "Validation complete. Errors: 0", vbInformation + End If + + Exit Sub + +ErrorHandler: + MsgBox "Error: " & Err.Description, vbCritical + Exit Sub +End Sub + +' +Private Sub DO_CSV_Export(ws As Excel.Worksheet) + On Error GoTo ExportError + + Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig() + Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName) + + Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(ws) + Dim startRow As Long: startRow = sheetConf("StartRow") - Dim startRow As Long: startRow = dataRange(3) - Dim errorCol As Long: errorCol = ws.Range(dataRange(2) & "1").Column If lastDataRow < startRow Then - MsgBox "No data found.", vbExclamation + MsgBox "No data rows to output.", vbExclamation Exit Sub End If + ' === Step 1: Validate all rows before export === + ' Do_Validation + Dim errorCount As Long + If Not RunValidationSilent(ws, errorCount) Then + If errorCount > 0 Then + MsgBox "Validation failed (" & errorCount & " errors). Export aborted.", vbCritical + Exit Sub + Else + MsgBox "Validation setup error. Export aborted.", vbCritical + Exit Sub + End If + End If + + ' === Step 2: Select save path === + Dim savePath As String: savePath = GetSaveCSVPath() + If savePath = "" Then Exit Sub + + ' === Step 3: Count data rows === + Dim rowCount As Long: rowCount = lastDataRow - startRow + 1 + + ' === Step 4: Count data columns === + Dim expectedColumnCount As Long: expectedColumnCount = sheetConf("ExpectedColumnCount") + Dim outputArr As Variant + ReDim outputArr(1 To rowCount + 1, 1 To expectedColumnCount) + + ' === Step 5: check export csv has header === + Dim hasHeader As Boolean: hasHeader = sheetConf("HasHeader") + Dim dataRow As Long: dataRow = 1 + + ' === Step 6: Build array with header and data === + If hasHeader Then + Dim headerArr As Variant + headerArr = GetCSVHeader(ws) + + Dim colIdx As Long + For colIdx = 0 To expectedColumnCount - 1 + outputArr(1, colIdx + 1) = headerArr(1, colIdx + 1) + Next colIdx + dataRow = dataRow + 1 + End If + + Dim colLetters As Variant: colLetters = sheetConf("HeaderColumns") + Dim r As Long + For r = startRow To lastDataRow + For colIdx = 0 To expectedColumnCount - 1 + outputArr(dataRow, colIdx + 1) = CleanCSVField(ws.Cells(r, Columns(colLetters(colIdx)).Column).Value) + Next colIdx + dataRow = dataRow + 1 + Next r + + On Error GoTo ExportError + Call WriteCSVFromArray(savePath, outputArr, sheetConf("CSV_Encoding"), sheetConf("AlwaysQuote")) + On Error GoTo 0 + + MsgBox "CSV export completed. Total data rows: " & rowCount, vbInformation + Exit Sub + +ExportError: + MsgBox "CSV export failed: " & Err.Description, vbExclamation +End Sub + +Private Sub Do_Sort(ws As Excel.Worksheet) + MsgBox "1" +End Sub + +Private Sub Do_Filter(ws As Excel.Worksheet) + On Error GoTo ErrorHandler + + Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig() + Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName) + + ' Check if auto filter is already on + If ws.AutoFilterMode Then + ws.AutoFilterMode = False + Exit Sub + End If + + Dim startCol As Long: startCol = ws.Range(sheetConf("StartCol") & "1").Column + Dim endCol As Long: endCol = ws.Range(sheetConf("EndCol") & "1").Column + + Dim filterRow As Long: filterRow = sheetConf("FilterRow") + + Dim filterRange As Range: Set filterRange = ws.Range(ws.Cells(filterRow, startCol), ws.Cells(filterRow, endCol)) + filterRange.AutoFilter + Exit Sub + +ErrorHandler: + MsgBox "Error: " & Err.Description, vbCritical +End Sub + +Private Sub Do_Fit(ws As Excel.Worksheet) + On Error GoTo ErrorHandler + + Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig() + Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName) + + Dim startCol As String: startCol = sheetConf("StartCol") + Dim endCol As String: endCol = sheetConf("EndCol") + + ws.Columns(startCol & ":" & endCol).AutoFit + Exit Sub + +ErrorHandler: + MsgBox "Error: " & Err.Description, vbCritical +End Sub + +' RunValidationSilent +private Function RunValidationSilent(ws As Worksheet, Optional ByRef errorCountOut As Long = 0) As Boolean + On Error GoTo ErrorHandler + + Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig() + Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName) + + ' check Validate method exist + If Not ProcedureExists(ws.CodeName, "Validate") Then + errorCountOut = -1 + RunValidationSilent = False + Exit Function + End If + + Dim validate As String: validate = ws.CodeName & ".Validate" + Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(ws) + Dim startRow As Long: startRow = sheetConf("StartRow") + Dim errorCol As Long: errorCol = ws.Range(sheetConf("ErrorCol") & "1").Column + + If lastDataRow < startRow Then + errorCountOut = 0 + RunValidationSilent = True + Exit Function + End If + + Dim r As Long + errorCountOut = 0 For r = startRow To lastDataRow - On Error GoTo ErrorHandler Application.Run validate, ws, r, lastDataRow If Trim(ws.Cells(r, errorCol).Value) <> "" Then - errorCount = errorCount + 1 + errorCountOut = errorCountOut + 1 End If Next r - ' === Refresh ws cache after validation passes === - If errorCount = 0 Then - Dim cacheMethodName As String: cacheMethodName = dataRange(5) - If - '' TODO - Call RefreshM1Cache - End If - - MsgBox "Validation complete. Errors: " & errorCount, vbInformation + RunValidationSilent = (errorCountOut = 0) + Exit Function ErrorHandler: - MsgBox "error" & Err.Description, vbCritical -End Sub - - - - - - - - + errorCountOut = -2 + RunValidationSilent = False +End Function Private Function ProcedureExists(moduleName As String, procName As String) As Boolean Dim VBProj As Object, VBComp As Object, CodeMod As Object diff --git a/src/module/Common_Functions.bas b/src/module/Common_Functions.bas index a6f9a7d..cb58e8a 100644 --- a/src/module/Common_Functions.bas +++ b/src/module/Common_Functions.bas @@ -15,7 +15,15 @@ Option Explicit ' Common Functions ' Get CSV header from specified row and columns -Function GetCSVHeader(ByVal ws As Worksheet, ByVal colLetters As Variant, ByVal headerRow As Long) As Variant +Function GetCSVHeader(ByVal ws As Worksheet) As Variant + On Error GoTo ErrorHandler + ' + Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig() + Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName) + + Dim colLetters As Variant: colLetters = sheetConf("HeaderColumns") + Dim headerRow As Long: headerRow = sheetConf("HeaderRow") + Dim colCount As Long: colCount = UBound(colLetters) - LBound(colLetters) + 1 Dim headerArr() As String ReDim headerArr(1 To 1, 1 To colCount) @@ -23,7 +31,10 @@ Function GetCSVHeader(ByVal ws As Worksheet, ByVal colLetters As Variant, ByVal Dim i As Long Dim cellValue As String For i = 0 To colCount - 1 - cellValue = Trim(ws.Cells(headerRow, Columns(colLetters(i)).Column).Value) + Dim colIndex As Long + colIndex = Columns(colLetters(i)).Column + + cellValue = Trim(ws.Cells(headerRow, colIndex).Value) cellValue = Replace(cellValue, vbLf, "") cellValue = Replace(cellValue, vbCr, "") cellValue = Replace(cellValue, vbCrLf, "") @@ -31,8 +42,13 @@ Function GetCSVHeader(ByVal ws As Worksheet, ByVal colLetters As Variant, ByVal Next i GetCSVHeader = headerArr + Exit Function + +ErrorHandler: + Err.Raise 1005, "GetCSVHeader", "Invalid column letter in HeaderColumns: '" & colLetters(i) & "'" End Function +' Function CleanCSVField(ByVal inputStr As String) As String Dim s As String s = Trim(inputStr) @@ -139,16 +155,16 @@ End Function ' obtain Function GetLastDataRowInRange(ws As Worksheet) As Long - If dataRangeDict Is Nothing Then Call RefreshDataRangeDict + Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig() - If dataRangeDict.Exists(ws.CodeName) Then - Dim dataRange As Variant: dataRange = dataRangeDict(ws.CodeName) + If sheetConfDict.Exists(ws.CodeName) Then + Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName) Dim startCol As Long, endCol As Long, startRow As Long On Error GoTo InvalidColumn - startCol = ws.Range(dataRange(0) & "1").Column - endCol = ws.Range(dataRange(1) & "1").Column - startRow = dataRange(3) + startCol = ws.Range(sheetConf("StartCol") & "1").Column + endCol = ws.Range(sheetConf("EndCol") & "1").Column + startRow = sheetConf("StartRow") On Error GoTo 0 ' --- query max row --- @@ -179,15 +195,37 @@ Function ClearDataRow(ByVal ws As Worksheet, ByVal startCol As Long, ByVal endCo End If End Function -Function ClearDataRows(ByVal ws As Worksheet, ByVal startCol As Long, ByVal endCol As Long, Optional ByVal startRow As Long = 7) - Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(ws, startCol, endCol, startRow) +Sub ClearDataRows(ByVal ws As Worksheet) + ' + Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig() + ' + If Not sheetConfDict.Exists(ws.CodeName) Then + Err.Raise 1004, "ClearDataRows", "Sheet not configured: " & ws.CodeName + End If + Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName) + + ' + Dim startRow As Long: startRow = sheetConf("StartRow") + Dim startCol As String: startCol = sheetConf("StartCol") + Dim endCol As String: endCol = sheetConf("EndCol") + Dim errorCol As String: errorCol = sheetConf("ErrorCol") + ' + Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(ws) + + ' If lastDataRow >= startRow Then - Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(startRow, startCol), ws.Cells(lastDataRow, endCol)) + Dim clearRange As Range + Set clearRange = ws.Range(ws.Cells(startRow, ws.Range(startCol & "1").Column), ws.Cells(lastDataRow, ws.Range(endCol & "1").Column)) clearRange.ClearContents clearRange.Interior.Color = vbWhite + + Dim clearErrorRange As Range + Set clearErrorRange = ws.Range(ws.Cells(startRow, ws.Range(errorCol & "1").Column), ws.Cells(lastDataRow, ws.Range(errorCol & "1").Column)) + clearErrorRange.ClearContents + clearErrorRange.Interior.Color = vbWhite End If -End Function +End Sub Sub SortDataRows(Optional ByVal sortColumn As Long = 3) Dim ws As Worksheet @@ -226,26 +264,6 @@ Sub SortDataRows(Optional ByVal sortColumn As Long = 3) Header:=xlNo End Sub -Sub ToggleAutoFilter(ByVal startColumn As Long, ByVal endColumn As Long, Optional ByVal filterRow As Long = 6) - Dim ws As Worksheet: Set ws = ActiveSheet - - ' Check if auto filter is already on - If ws.AutoFilterMode Then - ws.AutoFilterMode = False - Exit Sub - End If - If startColumn < 1 Or endColumn < startColumn Then Exit Sub - Dim filterRange As Range: Set filterRange = ws.Range(ws.Cells(filterRow, startColumn), ws.Cells(filterRow, endColumn)) - filterRange.AutoFilter -End Sub - -Sub AutoFitColumnWidth(ByVal fitColumnStart As Long, ByVal fitColumnEnd As Long) - Dim ws As Worksheet: Set ws = ActiveSheet - If fitColumnStart <= fitColumnEnd Then - ws.Range(ws.Columns(fitColumnStart), ws.Columns(fitColumnEnd)).AutoFit - End If -End Sub - ' Format: code:value (no space around colon) Function MakeSelect(ByVal code As String, ByVal value As String) As String MakeSelect = Trim(code) & ":" & Trim(value) diff --git a/src/module/Common_Generic_Master.bas b/src/module/Common_Generic_Master.bas deleted file mode 100644 index 46bdc04..0000000 --- a/src/module/Common_Generic_Master.bas +++ /dev/null @@ -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 \ No newline at end of file diff --git a/src/module/Common_Global_Cache.bas b/src/module/Common_Global_Cache.bas index 328d0e2..e2d37a5 100644 --- a/src/module/Common_Global_Cache.bas +++ b/src/module/Common_Global_Cache.bas @@ -10,26 +10,27 @@ Option Explicit ' - RefreshZ1Cache ' - RefreshZ2Cache ' - RefreshZ3Cache +' - RefreshZ4Cache ' - RefreshO1Cache ' - RefreshO2Cache ' ============================================================ ' Cache Variables -Public m1Cache As Object -Public m1KukanDCache As Object -Public z1Cache As Object -Public z2Cache As Object -Public z3Cache As Object -Public z4Cache As Object -Public o1Cache As Object -Public o2Cache As Object -Public m2Cache As Object -Public tokubetuList As Object -Public oufukuList As Object -Public koutaiList As Object -Public higaitouList As Object +Private m1Cache As Object +Private m1KukanDCache As Object +Private z1Cache As Object +Private z2Cache As Object +Private z3Cache As Object +Private z4Cache As Object +Private o1Cache As Object +Private o2Cache As Object +Private m2Cache As Object +Private tokubetuList As Object +Private oufukuList As Object +Private koutaiList As Object +Private higaitouList As Object -Public dataRangeDict As Object +Private sheetConfDict As Object ' m1Cache - used by M2_Kukan_detail, Tukin_C1 ' m1KukanDCache - nested dict {D: {F: [G]}} @@ -43,7 +44,7 @@ Public dataRangeDict As Object ' ============================================================ ' M1 Cache - { 区間コード[C]: [value1-7] } ' ============================================================ -Public Sub RefreshM1Cache() +Private Sub RefreshM1Cache(Optional ByVal charset As String = "cp932") Set m1Cache = Nothing On Error GoTo RefreshError @@ -62,7 +63,7 @@ End Sub ' Refresh M1_KukanD cache - nested dict {D: {F: [G]}} ' Structure: { 交通機関区分[D]: { 利用区間発名[F]: [利用区間着名G] } } -Public Sub RefreshM1KukanDCache() +Private Sub RefreshM1KukanDCache() Set m1KukanDCache = Nothing Set m1KukanDCache = CreateObject("Scripting.Dictionary") @@ -109,7 +110,7 @@ End Sub ' M2 Cache - Nested Dictionary ' Structure: { 区間コード[C]: { 券種[I]: { コード[J]: K } } } ' ============================================================ -Public Sub RefreshM2Cache() +Private Sub RefreshM2Cache() Set m2Cache = Nothing Set m2Cache = CreateObject("Scripting.Dictionary") @@ -157,7 +158,7 @@ End Sub ' ============================================================ ' Z1 Cache ' ============================================================ -Public Sub RefreshZ1Cache() +Private Sub RefreshZ1Cache() Set z1Cache = Nothing On Error GoTo RefreshError @@ -177,7 +178,7 @@ End Sub ' ============================================================ ' Z2 Cache ' ============================================================ -Public Sub RefreshZ2Cache() +Private Sub RefreshZ2Cache() Set z2Cache = Nothing On Error GoTo RefreshError @@ -197,7 +198,7 @@ End Sub ' ============================================================ ' Z3 Cache ' ============================================================ -Public Sub RefreshZ3Cache() +Private Sub RefreshZ3Cache() Set z3Cache = Nothing On Error GoTo RefreshError @@ -217,7 +218,7 @@ End Sub ' ============================================================ ' z4Cache ' ============================================================ -Public Sub RefreshZ4Cache() +Private Sub RefreshZ4Cache() On Error GoTo RefreshError Set z4Cache = LoadLookup("Z4", keyCol:=3, valueCols:=Array(4), startRow:=7) On Error GoTo 0 @@ -235,7 +236,7 @@ End Sub ' ============================================================ ' O1 Cache ' ============================================================ -Public Sub RefreshO1Cache() +Private Sub RefreshO1Cache() Set o1Cache = Nothing Set o1Cache = CreateObject("Scripting.Dictionary") @@ -287,7 +288,7 @@ End Sub ' ============================================================ ' O2 Cache ' ============================================================ -Public Sub RefreshO2Cache() +Private Sub RefreshO2Cache() Set o2Cache = Nothing On Error GoTo RefreshError @@ -307,7 +308,7 @@ End Sub ' ============================================================ ' tokubetuList ' ============================================================ -Public Sub GetTokubetu() +Private Sub RefreshTokubetu() On Error GoTo RefreshError Set tokubetuList = LoadLookup("Enum", keyCol:=1, valueCols:=Array(1), startRow:=3) On Error GoTo 0 @@ -325,7 +326,7 @@ End Sub ' ============================================================ ' oufukuList ' ============================================================ -Public Sub GetOufukuList() +Private Sub RefreshOufukuList() On Error GoTo RefreshError Set oufukuList = LoadLookup("Enum", keyCol:=6, valueCols:=Array(7), startRow:=3) On Error GoTo 0 @@ -343,7 +344,7 @@ End Sub ' ============================================================ ' koutaiList ' ============================================================ -Public Sub GetKoutaiList() +Private Sub RefreshKoutaiList() On Error GoTo RefreshError Set koutaiList = LoadLookup("Enum", keyCol:=9, valueCols:=Array(10), startRow:=3) On Error GoTo 0 @@ -361,7 +362,7 @@ End Sub ' ============================================================ ' higaitouList ' ============================================================ -Public Sub GetHigaitouList() +Private Sub RefreshHigaitouList() On Error GoTo RefreshError Set higaitouList = LoadLookup("Enum", keyCol:=12, valueCols:=Array(13), startRow:=3) On Error GoTo 0 @@ -376,8 +377,221 @@ RefreshError: Err.Raise 1001, "GetHigaitouList", "Failed to load Enum lookup cache: " & Err.Description End Sub -' sheetName : [START_COL, END_COL, ERROR_COL, START_ROW, HEADER_ROW, RefaushCacheName] -Public Sub RefreshDataRangeDict() - Set dataRangeDict = CreateObject("Scripting.Dictionary") - dataRangeDict("M1") = Array("C", "N", "O", 7, 5, "RefreshM1Cache") -End Sub \ No newline at end of file +Private Sub RefreshSheetDict() + Set sheetConfDict = CreateObject("Scripting.Dictionary") + Dim sheetConf As Object + + ' M1 + Set sheetConf = CreateObject("Scripting.Dictionary") + + sheetConf("StartCol") = "C" + sheetConf("EndCol") = "N" + sheetConf("ErrorCol") = "O" + sheetConf("StartRow") = 7 + sheetConf("HeaderRow") = 5 + sheetConf("RefreshCacheName") = "RefreshM1Cache" + sheetConf("CSV_Encoding") = "shift_jis" + sheetConf("HasHeader") = True + sheetConf("ExpectedColumnCount") = 12 + sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N") + sheetConf("AlwaysQuote") = False + sheetConf("FilterRow") = 6 + + Set sheetConfDict("M1") = sheetConf + + ' M2 + Set sheetConf = CreateObject("Scripting.Dictionary") + + sheetConf("StartCol") = "C" + sheetConf("EndCol") = "R" + sheetConf("ErrorCol") = "S" + sheetConf("StartRow") = 7 + sheetConf("HeaderRow") = 5 + sheetConf("RefreshCacheName") = "RefreshM2Cache" + sheetConf("CSV_Encoding") = "shift_jis" + sheetConf("HasHeader") = True + sheetConf("ExpectedColumnCount") = 11 + sheetConf("HeaderColumns") = Array("C", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R") + sheetConf("AlwaysQuote") = False + sheetConf("FilterRow") = 6 + + Set sheetConfDict("M2") = sheetConf + + ' Z1 + Set sheetConf = CreateObject("Scripting.Dictionary") + + sheetConf("StartCol") = "C" + sheetConf("EndCol") = "I" + sheetConf("ErrorCol") = "B" + sheetConf("StartRow") = 7 + sheetConf("HeaderRow") = 5 + sheetConf("RefreshCacheName") = "RefreshZ1Cache" + sheetConf("CSV_Encoding") = "utf-8" + sheetConf("HasHeader") = False + sheetConf("ExpectedColumnCount") = 7 + sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I") + sheetConf("AlwaysQuote") = True + sheetConf("FilterRow") = 6 + + Set sheetConfDict("Z1") = sheetConf + + ' Z2 + Set sheetConf = CreateObject("Scripting.Dictionary") + + sheetConf("StartCol") = "C" + sheetConf("EndCol") = "G" + sheetConf("ErrorCol") = "B" + sheetConf("StartRow") = 7 + sheetConf("HeaderRow") = 5 + sheetConf("RefreshCacheName") = "RefreshZ2Cache" + sheetConf("CSV_Encoding") = "utf-8" + sheetConf("HasHeader") = False + sheetConf("ExpectedColumnCount") = 5 + sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G") + sheetConf("AlwaysQuote") = True + sheetConf("FilterRow") = 6 + + Set sheetConfDict("Z2") = sheetConf + + ' Z3 + Set sheetConf = CreateObject("Scripting.Dictionary") + + sheetConf("StartCol") = "C" + sheetConf("EndCol") = "H" + sheetConf("ErrorCol") = "B" + sheetConf("StartRow") = 7 + sheetConf("HeaderRow") = 5 + sheetConf("RefreshCacheName") = "RefreshZ3Cache" + sheetConf("CSV_Encoding") = "utf-8" + sheetConf("HasHeader") = False + sheetConf("ExpectedColumnCount") = 6 + sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H") + sheetConf("AlwaysQuote") = True + sheetConf("FilterRow") = 6 + + Set sheetConfDict("Z3") = sheetConf + + ' Z4 + Set sheetConf = CreateObject("Scripting.Dictionary") + + sheetConf("StartCol") = "C" + sheetConf("EndCol") = "I" + sheetConf("ErrorCol") = "B" + sheetConf("StartRow") = 7 + sheetConf("HeaderRow") = 5 + sheetConf("RefreshCacheName") = "RefreshZ4Cache" + sheetConf("CSV_Encoding") = "utf-8" + sheetConf("HasHeader") = False + sheetConf("ExpectedColumnCount") = 7 + sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I") + sheetConf("AlwaysQuote") = True + sheetConf("FilterRow") = 6 + + Set sheetConfDict("Z4") = sheetConf + + ' O1 + Set sheetConf = CreateObject("Scripting.Dictionary") + + sheetConf("StartCol") = "C" + sheetConf("EndCol") = "F" + sheetConf("ErrorCol") = "" + sheetConf("StartRow") = 7 + sheetConf("HeaderRow") = "" + sheetConf("RefreshCacheName") = "RefreshO1Cache" + sheetConf("CSV_Encoding") = "utf-8" + sheetConf("HasHeader") = False + sheetConf("ExpectedColumnCount") = 7 + sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I") + sheetConf("AlwaysQuote") = True + sheetConf("FilterRow") = 6 + + Set sheetConfDict("O1") = sheetConf + + ' O2 + Set sheetConf = CreateObject("Scripting.Dictionary") + + sheetConf("StartCol") = "C" + sheetConf("EndCol") = "O" + sheetConf("ErrorCol") = "" + sheetConf("StartRow") = 7 + sheetConf("HeaderRow") = "" + sheetConf("RefreshCacheName") = "RefreshO2Cache" + sheetConf("CSV_Encoding") = "utf-8" + sheetConf("HasHeader") = False + sheetConf("ExpectedColumnCount") = 7 + sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I") + sheetConf("AlwaysQuote") = True + sheetConf("FilterRow") = 6 + + Set sheetConfDict("O2") = sheetConf +End Sub + +Public Function GetSheetConfig() As Object + If sheetConfDict Is Nothing Then Call RefreshSheetDict + Set GetSheetConfig = sheetConfDict +End Function + +Public Function GetM1Cache() As Object + If m1Cache Is Nothing Then Call RefreshM1Cache + Set GetM1Cache = m1Cache +End Function + +Public Function GetM1KukanDCache() As Object + If m1KukanDCache Is Nothing Then Call RefreshM1KukanDCache + Set GetM1KukanDCache = m1KukanDCache +End Function + +Public Function GetM2Cache() As Object + If m2Cache Is Nothing Then Call RefreshM2Cache + Set GetM2Cache = m2Cache +End Function + +Public Function GetZ1Cache() As Object + If z1Cache Is Nothing Then Call RefreshZ1Cache + Set GetZ1Cache = z1Cache +End Function + +Public Function GetZ2Cache() As Object + If z2Cache Is Nothing Then Call RefreshZ2Cache + Set GetZ2Cache = z2Cache +End Function + +Public Function GetZ3Cache() As Object + If z3Cache Is Nothing Then Call RefreshZ3Cache + Set GetZ3Cache = z3Cache +End Function + +Public Function GetZ4Cache() As Object + If z4Cache Is Nothing Then Call RefreshZ4Cache + Set GetZ4Cache = z4Cache +End Function + +Public Function GetO1Cache() As Object + If o1Cache Is Nothing Then Call RefreshO1Cache + Set GetO1Cache = o1Cache +End Function + +Public Function GetO2Cache() As Object + If o2Cache Is Nothing Then Call RefreshO2Cache + Set GetO2Cache = o2Cache +End Function + +Public Function GetOufukuList() As Object + If oufukuList Is Nothing Then Call RefreshOufukuList + Set GetOufukuList = oufukuList +End Function + +Public Function GetKoutaiList() As Object + If koutaiList Is Nothing Then Call RefreshKoutaiList + Set GetKoutaiList = koutaiList +End Function + +Public Function GetHigaitouList() As Object + If higaitouList Is Nothing Then Call RefreshHigaitouList + Set GetHigaitouList = higaitouList +End Function + +Public Function GetTokubetu() As Object + If tokubetuList Is Nothing Then Call RefreshTokubetu + Set GetTokubetu = tokubetuList +End Function \ No newline at end of file diff --git a/src/module/Common_Selector.bas b/src/module/Common_Selector.bas index 7bf0aba..25adf9f 100644 --- a/src/module/Common_Selector.bas +++ b/src/module/Common_Selector.bas @@ -17,7 +17,7 @@ Option Explicit ' Create transport (T) dropdown from Z1 cache Public Function BuildTransportList() - If z1Cache Is Nothing Then Call RefreshZ1Cache + Dim z1Cache As Object: Set z1Cache = GetZ1Cache() Dim dropdownList As String Dim key As Variant @@ -36,7 +36,7 @@ End Function ' Create todoke (G) dropdown Public Function BuildTodokeList() - If z4Cache Is Nothing Then Call RefreshZ4Cache + Dim z4Cache As Object: Set z4Cache = GetZ4Cache() Dim dropdownList As String Dim key As Variant @@ -54,7 +54,7 @@ End Function ' Create oufuku (M) dropdown Public Function BuildOufukuList() - If oufukuList Is Nothing Then Call GetOufukuList + Dim oufukuList As Object: Set oufukuList = GetOufukuList() Dim dropdownList As String Dim key As Variant @@ -72,7 +72,7 @@ End Function ' Create Koutai (N) dropdown Public Function BuildKoutaiList() - If koutaiList Is Nothing Then Call GetKoutaiList + Dim koutaiList As Object: Set koutaiList = GetKoutaiList() Dim dropdownList As String Dim key As Variant @@ -90,7 +90,7 @@ End Function ' Create Kettei (AU) dropdown Public Function BuildKetteiList() - If z2Cache Is Nothing Then Call RefreshZ2Cache + Dim z2Cache As Object: Set z2Cache = GetZ2Cache() Dim dropdownList As String Dim key As Variant @@ -108,7 +108,7 @@ End Function ' Create Higaitou (AW) dropdown Public Function BuildHigaitouList() - If higaitouList Is Nothing Then Call GetHigaitouList + Dim higaitouList As Object: Set higaitouList = GetHigaitouList() Dim dropdownList As String Dim key As Variant @@ -126,7 +126,7 @@ End Function ' Create MonthAmountKbn (AX) dropdown Public Function BuildMonthAmountKbnList() - If z3Cache Is Nothing Then Call RefreshZ3Cache + Dim z3Cache As Object: Set z3Cache = GetZ3Cache() Dim dropdownList As String Dim key As Variant @@ -144,7 +144,7 @@ End Function ' Create Kanshoku (BC) dropdown Public Function BuildKanshokuList() - If o2Cache Is Nothing Then Call RefreshO2Cache + Dim o2Cache As Object: Set o2Cache = GetO2Cache() Dim dropdownList As String Dim key As Variant diff --git a/src/sheet/C1.cls b/src/sheet/C1.cls index 96a933f..925b7d8 100644 --- a/src/sheet/C1.cls +++ b/src/sheet/C1.cls @@ -108,6 +108,7 @@ Private Sub Worksheet_Change(ByVal Target As Range) If intersectRng Is Nothing Then Exit Sub If Target.Row < 7 Then Exit Sub + Dim idx As Long Application.EnableEvents = False On Error GoTo Finally @@ -139,7 +140,6 @@ Private Sub Worksheet_Change(ByVal Target As Range) End If ' === Transport column changes (T, AA, AH, AO) === - Dim idx As Long idx = GetIdx(Target.Column, KUKAN_TRANSPORT_COLS) If idx >= 0 Then Dim cellT As Range @@ -260,7 +260,7 @@ End Sub ' Fill kukan info from M1 cache (key: kukan code, value: 7 elements) Private Sub FillKukanFromM1(ByVal rowNum As Long, ByVal idx As Long) - If m1Cache Is Nothing Then Call RefreshM1Cache + Dim m1Cache As Object: Set m1Cache = GetM1Cache() Dim codeCol As Long: codeCol = KUKAN_CODE_COLS(idx) Dim transportCol As Long: transportCol = KUKAN_TRANSPORT_COLS(idx) @@ -293,7 +293,7 @@ End Sub ' Fill address dropdown from O1 cache Private Sub FillAddressFromO1(ByVal rowNum As Long) - If o1Cache Is Nothing Then Call RefreshO1Cache + Dim o1Cache As Object: Set o1Cache = GetO1Cache() Dim empNo As String empNo = Trim(Me.Cells(rowNum, 3).Value) @@ -329,7 +329,7 @@ End Sub ' Create station (利用区間発) dropdown from M1_KukanD cache Private Sub CreateFromStationDropdown(ByVal rowNum As Long, ByVal transportCol As Long, ByVal stationCol As Long) - If m1KukanDCache Is Nothing Then Call RefreshM1KukanDCache + Dim m1KukanDCache As Object: Set m1KukanDCache = GetM1KukanDCache() Dim transport As String: transport = GetCode(Me.Cells(rowNum, transportCol).Value) If transport = "" Then Exit Sub @@ -361,7 +361,7 @@ End Sub ' Create destination (利用区間着) dropdown from M1_KukanD cache ' Structure: { D: { F: [G] } } Private Sub CreateToStationDropdown(ByVal rowNum As Long, ByVal transportCol As Long, ByVal stationFromCol As Long, ByVal stationToCol As Long) - If m1KukanDCache Is Nothing Then Call RefreshM1KukanDCache + Dim m1KukanDCache As Object: Set m1KukanDCache = GetM1KukanDCache() Dim transport As String: transport = GetCode(Me.Cells(rowNum, transportCol).Value) Dim stationFrom As String: stationFrom = GetCode(Me.Cells(rowNum, stationFromCol).Value) @@ -396,7 +396,7 @@ End Sub ' Find kukan code by transport + station_from + station_to (reverse lookup) Private Function FindKukanCodeByStation(ByVal rowNum As Long, ByVal transportCol As Long, ByVal stationFromCol As Long, ByVal stationToCol As Long) As String - If m1Cache Is Nothing Then Call RefreshM1Cache + Dim m1Cache As Object: Set m1Cache = GetM1Cache() Dim transportKbn As String: transportKbn = GetCode(Trim(Me.Cells(rowNum, transportCol).Value)) Dim stationFrom As String: stationFrom = Trim(Me.Cells(rowNum, stationFromCol).Value) @@ -427,7 +427,7 @@ End Sub ' Create dropdown from M2 cache: get code (J列) list for kukanCode + kanshu Private Sub CreateM2CodeDropdown(ByVal rowNum As Long, ByVal kukanCodeCol As Long, ByVal kanshuCol As Long, ByVal codeCol As Long) - If m2Cache Is Nothing Then Call RefreshM2Cache + Dim m2Cache As Object: Set m2Cache = GetM2Cache() Dim kukanCode As String: kukanCode = Trim(Me.Cells(rowNum, kukanCodeCol).Value) Dim kanshu As String: kanshu = Trim(Me.Cells(rowNum, kanshuCol).Value) @@ -465,34 +465,19 @@ Private Sub ClearRowData(ByVal rowNum As Long) Me.Cells(rowNum, ERROR_COL).ClearContents End Sub -' ====== Button Macros ====== -Private Sub validateButton() - Dim lastRow As Long, r As Long, errorCount As Long - lastRow = GetLastDataRowInRange(Me, START_COL, END_COL) - - If lastRow < 7 Then - MsgBox "No data found.", vbExclamation - Exit Sub - End If - - errorCount = 0 - For r = 7 To lastRow - Call Validate(r) - If Trim(Cells(r, ERROR_COL).Value) <> "" Then - errorCount = errorCount + 1 - End If - Next r - - MsgBox "Validation complete. Errors: " & errorCount, vbInformation -End Sub - ' Validation logic -Private Private Sub validate(ByVal rowNum As Long) - Set ws = Me - - ' Clear background color - Me.Range(Me.Cells(rowNum, START_COL), Me.Cells(rowNum, END_COL)).Interior.Color = vbWhite - +Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long) + + Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig() + Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName) + + Dim startCol As String: startCol = sheetConf("StartCol") + Dim endCol As String: endCol = sheetConf("EndCol") + Dim errorCol As String: errorCol = sheetConf("ErrorCol") + + Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol)) + clearRange.Interior.Color = vbWhite + ' Required columns: C-G, K-N, AW Dim requiredCols As Variant requiredCols = Array("C", "D", "E", "F", "G", "K", "L", "M", "N", "AW") @@ -507,15 +492,3 @@ Private Private Sub validate(ByVal rowNum As Long) Me.Cells(rowNum, ERROR_COL).ClearContents End Sub - -Private Sub Do_Sort() - Call SortDataRows(3) -End Sub - -Private Sub Do_Filter() - Call ToggleAutoFilter(START_COL, END_COL) -End Sub - -Private Sub Do_Fit() - Call AutoFitColumnWidth(START_COL, END_COL) -End Sub diff --git a/src/sheet/M1.cls b/src/sheet/M1.cls index 18d2d1c..f96cad7 100644 --- a/src/sheet/M1.cls +++ b/src/sheet/M1.cls @@ -2,29 +2,14 @@ ' Module Name: Master_Kukan ' Module Desc: M1 Kukan master data management (import/export/validate) ' Module Methods: -' - Import -' - Export -' - validateButton_Click -' - SortData -' - ToggleAutoFilter +' - CreateEnumDropdown ' - Worksheet_Change -' - ValidateRow -' - FillValidationDropdown -' - ValidateAllRows +' - Validate ' ============================================================ -' ====== Constants ====== -Const START_COL As Long = 3 ' C column -Const END_COL As Long = 14 ' N column -Const ERROR_COL As Long = 15 ' O column -Const HEADER_ROW As Long = 5 - -Function HEADERS() As Variant - HEADERS = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N") -End Function ' Create dropdown for L column Private Sub CreateEnumDropdown(ByVal rowNum As Long) - If tokubetuList Is Nothing Then Call GetTokubetu + Dim tokubetuList As Object: Set tokubetuList = GetTokubetu() ' Build dropdown list from tokubetuList Dim dropdownList As String dropdownList = "" @@ -49,7 +34,7 @@ Private Sub CreateEnumDropdown(ByVal rowNum As Long) End Sub - +' Private Sub Worksheet_Change(ByVal Target As Range) ' === Column C changes: Create L column dropdown === If Target.Column = 3 And Target.Row >= 7 Then @@ -66,7 +51,7 @@ Private Sub Worksheet_Change(ByVal Target As Range) ' === Column D changes: Fill E column === If Target.Column = 4 And Target.Row >= 7 Then - If z1Cache Is Nothing Then Call RefreshZ1Cache + Dim z1Cache As Object: Set z1Cache = GetZ1Cache() Dim cellD As Range For Each cellD In Target @@ -85,57 +70,23 @@ Private Sub Worksheet_Change(ByVal Target As Range) End If End Sub -Sub Import(wsTarget As Worksheet) - ' === Step 1: Select CSV file === - Dim filePath As String: filePath = SelectCSVFile() - If filePath = "" Then Exit Sub +Private Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long) - ' === Step 2: Read CSV with Shift-JIS (using common function) === - On Error GoTo ImportError - Dim csvData As Variant: csvData = ReadCSVAs2DArrayStrict(filePath, 12, "shift_jis", True) - On Error GoTo 0 + Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig() + Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName) - If UBound(csvData, 1) < 1 Then - MsgBox "No data in CSV.", vbExclamation - Exit Sub - End If - - ' === Step 3:Clear all data rows before import === - Application.EnableEvents = False - Call ClearDataRows(wsTarget, START_COL, END_COL, 7) - Application.EnableEvents = True + Dim startCol As String: startCol = sheetConf("StartCol") + Dim endCol As String: endCol = sheetConf("EndCol") + Dim errorCol As String: errorCol = sheetConf("ErrorCol") - ' === Step 4: Write CSV data to worksheet === - Dim colLetters As Variant: colLetters = HEADERS() - Dim writeRow As Long: writeRow = 7 - Dim i As Long - For i = LBound(csvData, 1) To UBound(csvData, 1) - ' CSV col 1-12 -> C-N column - Dim j As Long - For j = 0 To 11 - wsTarget.Cells(writeRow, Columns(colLetters(j)).Column).Value = CleanCSVField(CStr(csvData(i, j + 1))) - Next j - writeRow = writeRow + 1 - Next i - - MsgBox writeRow - 7 & " rows imported.", vbInformation - Exit Sub - -ImportError: - MsgBox "CSV import failed: " & Err.Description, vbExclamation -End Sub - -Private Sub validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long) - - Dim clearRange As Range - Set clearRange = ws.Range(ws.Cells(rowNum, START_COL), ws.Cells(rowNum, END_COL)) + Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol)) clearRange.Interior.Color = vbWhite ' Check column required Dim colLetter As Variant For Each colLetter In Array("C", "D", "E", "F", "G", "I", "L") If Trim(ws.Range(colLetter & rowNum).Value) = "" Then - ws.Cells(rowNum, ERROR_COL).Value = colLetter & " column is required" + ws.Cells(rowNum, errorCol).Value = colLetter & " column is required" ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If @@ -145,7 +96,7 @@ Private Sub validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As For Each colLetter In Array("H", "I", "J", "N") Dim val As String: val = Trim(ws.Range(colLetter & rowNum).Value) If val <> "" And Not IsNumeric(val) Then - ws.Cells(rowNum, ERROR_COL).Value = colLetter & " column must be numeric" + ws.Cells(rowNum, errorCol).Value = colLetter & " column must be numeric" ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If @@ -157,27 +108,27 @@ Private Sub validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Set foundCell = ws.Range("C7:C" & lastDataRow).Find(What:=cValue, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext) If Not foundCell Is Nothing Then If foundCell.Row <> rowNum Then - ws.Cells(rowNum, ERROR_COL).Value = "C column value is duplicated" + ws.Cells(rowNum, errorCol).Value = "C column value is duplicated" ws.Range("C" & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If End If ' Check D and E column in the cache - If z1Cache Is Nothing Then Call RefreshZ1Cache + Dim z1Cache As Object: Set z1Cache = GetZ1Cache() Dim dValue As String: dValue = Trim(ws.Range("D" & rowNum).Value) Dim eValue As String: eValue = Trim(ws.Range("E" & rowNum).Value) If Not z1Cache.Exists(dValue) Then - ws.Cells(rowNum, ERROR_COL).Value = "D column does not exist." + ws.Cells(rowNum, errorCol).Value = "D column does not exist." ws.Range("D" & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub Else Dim valueArray As Variant valueArray = z1Cache(dValue) If Not IsArray(valueArray) Or UBound(valueArray) < 0 Then - ws.Cells(rowNum, ERROR_COL).Value = "Invalid reference data for D column." + ws.Cells(rowNum, errorCol).Value = "Invalid reference data for D column." Exit Sub End If @@ -185,121 +136,22 @@ Private Sub validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As expectedEValue = Trim(CStr(valueArray(0))) If eValue <> expectedEValue Then - ws.Cells(rowNum, ERROR_COL).Value = "E column does not match reference data." + ws.Cells(rowNum, errorCol).Value = "E column does not match reference data." ws.Range("E" & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If End If ' Check L column in the tokubetuList - If tokubetuList Is Nothing Then Call GetTokubetu + + Dim tokubetuList As Object: Set tokubetuList = GetTokubetu() Dim lValue As String: lValue = Trim(ws.Range("L" & rowNum).Value) If Not tokubetuList.Exists(lValue) Then - ws.Cells(rowNum, ERROR_COL).Value = "L column does not exist." + ws.Cells(rowNum, errorCol).Value = "L column does not exist." ws.Range("L" & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If ' Validation passed - clear error - ws.Cells(rowNum, ERROR_COL).ClearContents + ws.Cells(rowNum, errorCol).ClearContents End Sub - -' Validate button -Sub validateAll(ws As Worksheet) - Dim lastDataRow As Long, r As Long, errorCount As Long - lastDataRow = GetLastDataRowInRange(ws, START_COL, END_COL) - - If lastDataRow < 7 Then - MsgBox "No data found.", vbExclamation - Exit Sub - End If - - For r = 7 To lastDataRow - Validate r, lastDataRow - If Trim(ws.Cells(r, ERROR_COL).Value) <> "" Then - errorCount = errorCount + 1 - End If - Next r - - ' === Refresh M1 cache after validation passes === - If errorCount = 0 Then - Call RefreshM1Cache - End If - - MsgBox "Validation complete. Errors: " & errorCount, vbInformation -End Sub - -Private Sub Export() - Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(Me, START_COL, END_COL) - If lastDataRow < 7 Then - MsgBox "No data rows to output.", vbExclamation - Exit Sub - End If - - ' === Step 1: Validate all rows before export === - Dim ws As Worksheet: Set ws = Me - Dim r As Long, errorCount As Long - For r = 7 To lastDataRow - Call validate(r, lastDataRow) - If Trim(ws.Cells(r, ERROR_COL).Value) <> "" Then - errorCount = errorCount + 1 - End If - Next r - - If errorCount > 0 Then - MsgBox "Validation failed. Found " & errorCount & " error(s). Please correct them before exporting.", vbCritical - Exit Sub - End If - - ' === Step 2: Select save path === - Dim savePath As String: savePath = GetSaveCSVPath() - If savePath = "" Then Exit Sub - - ' === Step 3: Count data rows === - Dim rowCount As Long: rowCount = lastDataRow - 6 - - ' === Step 4: Build array with header and data === - Dim headerArr As Variant - Dim colLetters As Variant: colLetters = HEADERS() - headerArr = GetCSVHeader(ws, colLetters, HEADER_ROW) - - Dim outputArr As Variant - ReDim outputArr(1 To rowCount + 1, 1 To 12) - - ' Row 1: header - Dim colIdx As Long - For colIdx = 0 To 11 - outputArr(1, colIdx + 1) = headerArr(1, colIdx + 1) - Next colIdx - - ' Rows 2+: data (C-N columns) - Dim dataRow As Long: dataRow = 2 - For r = 7 To lastDataRow - For colIdx = 0 To 11 - outputArr(dataRow, colIdx + 1) = CleanCSVField(ws.Cells(r, Columns(colLetters(colIdx)).Column).Value) - Next colIdx - dataRow = dataRow + 1 - Next r - - On Error GoTo ExportError - Call WriteCSVFromArray(savePath, outputArr, "shift_jis", False) - On Error GoTo 0 - - MsgBox "CSV export completed. Total data rows: " & rowCount, vbInformation - Exit Sub - -ExportError: - MsgBox "CSV export failed: " & Err.Description, vbExclamation -End Sub - -Private Sub Do_Sort() - Call SortDataRows(3) -End Sub - -Private Sub Do_Filter() - Call ToggleAutoFilter(START_COL, END_COL) -End Sub - -Private Sub Do_Fit() - Call AutoFitColumnWidth(START_COL, END_COL) -End Sub \ No newline at end of file diff --git a/src/sheet/M2.cls b/src/sheet/M2.cls index a88a5e4..7d6960c 100644 --- a/src/sheet/M2.cls +++ b/src/sheet/M2.cls @@ -2,28 +2,11 @@ ' Module Name: Master_Kukan_detail ' Module Desc: M2 Kukan detail master data management ' Module Methods: -' - Import -' - Export -' - validateButton_Click -' - SortData -' - ToggleAutoFilter ' - Worksheet_Change -' - ValidateRow -' - FillValidationDropdown -' - ValidateAllRows +' - FillFromM1 +' - validateButton_Click +' - Validate ' ============================================================ -' ====== Constants ====== -Const START_COL As Long = 3 ' C column -Const END_COL As Long = 18 ' R column -Const ERROR_COL As Long = 19 ' S column -Const HEADER_ROW As Long = 6 - -Function HEADERS() As Variant - HEADERS = Array("C", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R") -End Function - -' ====== Function ====== - Private Sub Worksheet_Change(ByVal Target As Range) ' === Fill D, E when C column changes === If Target.Column = 3 And Target.Row >= 7 Then @@ -38,10 +21,10 @@ Private Sub Worksheet_Change(ByVal Target As Range) End If End Sub -Sub FillFromM1(ByVal rowNum As Long, Optional ByVal setG As Boolean = True) +Private Sub FillFromM1(ByVal rowNum As Long, Optional ByVal setG As Boolean = True) Set ws = Me - If m1Cache Is Nothing Then Call RefreshM1Cache + Dim m1Cache As Object: Set m1Cache = GetM1Cache() Dim cValue As String: cValue = Trim(ws.Range("C" & rowNum).Value) ' Fill D, E, F, G, H columns from M1 cache @@ -72,67 +55,31 @@ Sub FillFromM1(ByVal rowNum As Long, Optional ByVal setG As Boolean = True) ws.Cells(rowNum, 8).Value = Trim(cacheVal(6)) End Sub -Sub ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long) +Private Sub ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long) ' Clear from D column onwards ws.Range(ws.Cells(rowNum, 4), ws.Cells(rowNum, 15)).ClearContents ws.Cells(rowNum, 6).Validation.Delete ws.Cells(rowNum, 19).ClearContents ' Q column error info End Sub -Private Sub Import() - ' === Step 1: Select CSV file === - Dim filePath As String: filePath = SelectCSVFile() - If filePath = "" Then Exit Sub +Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long) - ' === Step 2: Read CSV with Shift-JIS (using common function) === - On Error GoTo ImportError - Dim csvData As Variant: csvData = ReadCSVAs2DArrayStrict(filePath, 11, "shift_jis", True) - On Error GoTo 0 + Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig() + Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName) - If UBound(csvData, 1) < 1 Then - MsgBox "No data in CSV.", vbExclamation - Exit Sub - End If - - ' === Step 3:Clear all data rows before import === - Application.EnableEvents = False - Dim wsTarget As Worksheet: Set wsTarget = Me - Call ClearDataRows(wsTarget, START_COL, ERROR_COL, 7) - Application.EnableEvents = True + Dim startCol As String: startCol = sheetConf("StartCol") + Dim endCol As String: endCol = sheetConf("EndCol") + Dim errorCol As String: errorCol = sheetConf("ErrorCol") - ' === Step 4: Write CSV data to worksheet === - Dim colLetters As Variant: colLetters = HEADERS() - Dim writeRow As Long: writeRow = 7 - Dim i As Long - For i = LBound(csvData, 1) To UBound(csvData, 1) - ' CSV col 1-11 -> C, I-R column - Dim j As Long - For j = 0 To 10 - wsTarget.Cells(writeRow, Columns(colLetters(j)).Column).Value = CleanCSVField(CStr(csvData(i, j + 1))) - Next j - writeRow = writeRow + 1 - Next i - - MsgBox writeRow - 7 & " rows imported.", vbInformation - Exit Sub - -ImportError: - MsgBox "CSV import failed: " & Err.Description, vbExclamation -End Sub - -Private Sub validate(ByVal rowNum As Long, ByVal lastDataRow As Long) - Set ws = Me - - Dim clearRange As Range - Set clearRange = ws.Range(ws.Cells(rowNum, START_COL), ws.Cells(rowNum, END_COL)) + Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol)) clearRange.Interior.Color = vbWhite ' Check C column in the cache - If m1Cache Is Nothing Then Call RefreshM1Cache + Dim m1Cache As Object: Set m1Cache = GetM1Cache() Dim cValue As String: cValue = Trim(ws.Range("C" & rowNum).Value) If cValue <> "" AND Not m1Cache.Exists(cValue) Then - ws.Cells(rowNum, ERROR_COL).Value = "C column does not exist in M1." + ws.Cells(rowNum, errorCol).Value = "C column does not exist in M1." ws.Range("C" & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If @@ -141,7 +88,7 @@ Private Sub validate(ByVal rowNum As Long, ByVal lastDataRow As Long) Dim colLetter As Variant For Each colLetter In Array("C", "I", "J", "K") If Trim(ws.Range(colLetter & rowNum).Value) = "" Then - ws.Cells(rowNum, ERROR_COL).Value = colLetter & " column is required" + ws.Cells(rowNum, errorCol).Value = colLetter & " column is required" ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If @@ -153,7 +100,7 @@ Private Sub validate(ByVal rowNum As Long, ByVal lastDataRow As Long) For Each col In numericCols Dim val As String: val = Trim(ws.Range(col & rowNum).Value & "") If val <> "" And Not IsNumeric(val) Then - ws.Cells(rowNum, ERROR_COL).Value = col & " column must be numeric" + ws.Cells(rowNum, errorCol).Value = col & " column must be numeric" ws.Range(col & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If @@ -163,105 +110,9 @@ Private Sub validate(ByVal rowNum As Long, ByVal lastDataRow As Long) Dim kenshuKbn As Variant: kenshuKbn = Array("1", "2", "3") Dim iValue As String: iValue = Trim(ws.Range("I" & rowNum).Value) If UBound(Filter(kenshuKbn, iValue)) = -1 Then - ws.Cells(rowNum, ERROR_COL).Value = "I column (kenshuKbn) must be 1, 2, or 3" + ws.Cells(rowNum, errorCol).Value = "I column (kenshuKbn) must be 1, 2, or 3" ws.Range("I" & rowNum).Interior.Color = RGB(255, 0, 0) Exit Sub End If End Sub - -' Button macro (Validate selected row) -Private Sub validateButton() - Dim lastDataRow As Long, r As Long, errorCount As Long - lastDataRow = GetLastDataRowInRange(Me, START_COL, END_COL) - - If lastDataRow < 7 Then - MsgBox "No data found.", vbExclamation - Exit Sub - End If - - For r = 7 To lastDataRow - Validate r, lastDataRow - If Trim(Cells(r, ERROR_COL).Value) <> "" Then - errorCount = errorCount + 1 - End If - Next r - - MsgBox "Validation complete. Errors: " & errorCount, vbInformation -End Sub - -Private Sub Export() - Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(Me, START_COL, END_COL) - If lastDataRow < 7 Then - MsgBox "No data rows to output.", vbExclamation - Exit Sub - End If - - ' === Step 1: Validate all rows before export === - Dim ws As Worksheet: Set ws = Me - Dim r As Long, errorCount As Long - For r = 7 To lastDataRow - Call validate(r, lastDataRow) - If Trim(ws.Cells(r, ERROR_COL).Value) <> "" Then - errorCount = errorCount + 1 - End If - Next r - - If errorCount > 0 Then - MsgBox "Validation failed. Found " & errorCount & " error(s). Please correct them before exporting.", vbCritical - Exit Sub - End If - - ' === Step 2: Select save path === - Dim savePath As String: savePath = GetSaveCSVPath() - If savePath = "" Then Exit Sub - - ' === Step 3: Count data rows === - Dim rowCount As Long: rowCount = lastDataRow - 6 - - ' === Step 4: Build array with header and data === - Dim headerArr As Variant - Dim colLetters As Variant: colLetters = HEADERS() - headerArr = GetCSVHeader(ws, colLetters, HEADER_ROW) - - Dim outputArr As Variant - ReDim outputArr(1 To rowCount + 1, 1 To 11) - - ' Row 1: header - Dim colIdx As Long - For colIdx = 0 To 10 - outputArr(1, colIdx + 1) = headerArr(1, colIdx + 1) - Next colIdx - - ' Rows 2+: data (C, I-R columns) - Dim dataRow As Long: dataRow = 2 - For r = 7 To lastDataRow - For colIdx = 0 To 10 - outputArr(dataRow, colIdx + 1) = CleanCSVField(ws.Cells(r, Columns(colLetters(colIdx)).Column).Value) - Next colIdx - dataRow = dataRow + 1 - Next r - - On Error GoTo ExportError - Call WriteCSVFromArray(savePath, outputArr, "shift_jis", False) - On Error GoTo 0 - - MsgBox "CSV export completed. Total data rows: " & rowCount, vbInformation - Exit Sub - -ExportError: - MsgBox "CSV export failed: " & Err.Description, vbExclamation - -End Sub - -Private Sub Do_Sort() - Call SortDataRows(3) -End Sub - -Private Sub Do_Filter() - Call ToggleAutoFilter(START_COL, END_COL) -End Sub - -Private Sub Do_Fit() - Call AutoFitColumnWidth(START_COL, END_COL) -End Sub \ No newline at end of file diff --git a/src/sheet/O1.cls b/src/sheet/O1.cls index 8129eca..c092094 100644 --- a/src/sheet/O1.cls +++ b/src/sheet/O1.cls @@ -2,59 +2,4 @@ ' Module Name: Master_address ' Module Desc: O1 address master data management ' Module Methods: -' - Import -' - Export -' - SortData -' - ToggleAutoFilter ' ============================================================ -Private Sub Import() - Dim filePath As String - Dim lines As Variant - Dim i As Long - Dim writeRow As Long - - Set ws = Me - - On Error GoTo ErrorHandler - - ' Step 1: Select CSV file - filePath = SelectCSVFile() - If filePath = "" Then Exit Sub - - ' Step 2: Read CSV and return 2D array - lines = ReadCSVAs2DArrayStrict(filePath, 4, "shift-jis", True) - - ' Step 3: Clear data rows - Call Generic_ClearDataRows(ws, 7, 3) - - ' Step 4: Import data - writeRow = 7 - For i = LBound(lines, 1) To UBound(lines, 1) - If Not isRowEmpty Then - Dim colOffset As Long - For colOffset = 1 To 4 - ws.Cells(writeRow, 2 + colOffset).Value = CleanCSVField(CStr(lines(i, colOffset))) - Next colOffset - writeRow = writeRow + 1 - End If - Next i - - MsgBox writeRow - 7 & " rows imported.", vbInformation - - Exit Sub - -ErrorHandler: - MsgBox "Import fails:" & vbCrLf & Err.Description, vbCritical -End Sub - -Private Sub Do_Sort() - Call SortDataRows(3) -End Sub - -Private Sub Do_Filter() - Call ToggleAutoFilter(3, 5) -End Sub - -Private Sub Do_Fit() - Call AutoFitColumnWidth(3, 5) -End Sub diff --git a/src/sheet/O2.cls b/src/sheet/O2.cls index 5833022..15dc212 100644 --- a/src/sheet/O2.cls +++ b/src/sheet/O2.cls @@ -2,24 +2,5 @@ ' Module Name: Master_507 ' Module Desc: O2 master data management (507) ' Module Methods: -' - Import -' - Export -' - SortData -' - ToggleAutoFilter ' ============================================================ ' ====== (507) ======= -Private Sub Import() - Call Generic_Master_Import(Me, 13) -End Sub - -Private Sub Do_Sort() - Call SortDataRows(3) -End Sub - -Private Sub Do_Filter() - Call ToggleAutoFilter(3, 15) -End Sub - -Private Sub Do_Fit() - Call AutoFitColumnWidth(3, 15) -End Sub diff --git a/src/sheet/Z1.cls b/src/sheet/Z1.cls index f867988..2cd6efa 100644 --- a/src/sheet/Z1.cls +++ b/src/sheet/Z1.cls @@ -2,64 +2,31 @@ ' Module Name: Master_222 ' Module Desc: Z1 master data management (222) ' Module Methods: -' - Import -' - Export -' - SortData -' - ToggleAutoFilter +' - Validate ' ============================================================ -' ====== (222) ======= +' +Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long) -' ====== Constants ====== -Const START_COL As Long = 3 -Const END_COL As Long = 9 -Const ERROR_COL As Long = 2 + Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig() + Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName) -' ====== Function ====== -Private Sub Import() - Call Generic_Master_Import(Me, 7) -End Sub - -Private Sub Export() - Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(Me, START_COL, END_COL) - - If lastDataRow < 7 Then - MsgBox "No data rows to output.", vbExclamation - Exit Sub - End If - - Dim r As Long, errorCount As Long - For r = 7 To lastDataRow - Validate r - If Trim(Cells(r, 2).Value & "") <> "" Then - errorCount = errorCount + 1 - End If - Next r - - If errorCount > 0 Then - MsgBox "Validation failed. Found " & errorCount & " error(s). Please correct them before exporting.", vbCritical - Exit Sub - End If - - Call Generic_Master_Export(Me, 7, lastDataRow) -End Sub - -Private Sub validate(ByVal rowNum As Long) - Set ws = Me - Dim cValue As String: cValue = Trim(ws.Cells(rowNum, 3).Value) + Dim startCol As String: startCol = sheetConf("StartCol") + Dim endCol As String: endCol = sheetConf("EndCol") + Dim errorCol As String: errorCol = sheetConf("ErrorCol") ' clear C~I columns background color - Dim clearRange As Range - Set clearRange = ws.Range(ws.Cells(rowNum, START_COL), ws.Cells(rowNum, END_COL)) + Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol)) clearRange.Interior.Color = vbWhite + Dim cValue As String: cValue = Trim(ws.Cells(rowNum, 3).Value) If cValue = "" Then - ws.Cells(rowNum, 2).Value = "C column is required" + ws.Cells(rowNum, errorCol).Value = "C column is required" ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0) Exit Sub End If If Len(cValue) <> 3 Then - ws.Cells(rowNum, 2).Value = "C column must be 3 characters" + ws.Cells(rowNum, errorCol).Value = "C column must be 3 characters" ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0) Exit Sub End If @@ -69,7 +36,7 @@ Private Sub validate(ByVal rowNum As Long) For i = 1 To 3 ch = Mid(cValue, i, 1) If Not ((ch >= "0" And ch <= "9") Or (ch >= "A" And ch <= "Z") Or (ch >= "a" And ch <= "z")) Then - ws.Cells(rowNum, 2).Value = "C column must be alphanumeric" + ws.Cells(rowNum, errorCol).Value = "C column must be alphanumeric" ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0) Exit Sub End If @@ -78,12 +45,12 @@ Private Sub validate(ByVal rowNum As Long) Dim dValue As String dValue = Trim(ws.Cells(rowNum, 4).Value) If dValue = "" Then - ws.Cells(rowNum, 2).Value = "D column is required" + ws.Cells(rowNum, errorCol).Value = "D column is required" ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0) Exit Sub End If If Len(dValue) > 80 Then - ws.Cells(rowNum, 2).Value = "D column must be within 80 characters" + ws.Cells(rowNum, errorCol).Value = "D column must be within 80 characters" ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0) Exit Sub End If @@ -91,12 +58,12 @@ Private Sub validate(ByVal rowNum As Long) Dim eValue As String eValue = Trim(ws.Cells(rowNum, 5).Value) If eValue = "" Then - ws.Cells(rowNum, 2).Value = "E column is required" + ws.Cells(rowNum, errorCol).Value = "E column is required" ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0) Exit Sub End If If Len(eValue) > 80 Then - ws.Cells(rowNum, 2).Value = "E column must be within 80 characters" + ws.Cells(rowNum, errorCol).Value = "E column must be within 80 characters" ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0) Exit Sub End If @@ -104,7 +71,7 @@ Private Sub validate(ByVal rowNum As Long) Dim fValue As String fValue = Trim(ws.Cells(rowNum, 6).Value) If fValue <> "" And Len(fValue) > 80 Then - ws.Cells(rowNum, 2).Value = "F column must be within 80 characters" + ws.Cells(rowNum, errorCol).Value = "F column must be within 80 characters" ws.Cells(rowNum, 6).Interior.Color = RGB(255, 0, 0) Exit Sub End If @@ -112,7 +79,7 @@ Private Sub validate(ByVal rowNum As Long) Dim gValue As String gValue = Trim(ws.Cells(rowNum, 7).Value) If gValue <> "" And Len(gValue) > 80 Then - ws.Cells(rowNum, 2).Value = "G column must be within 80 characters" + ws.Cells(rowNum, errorCol).Value = "G column must be within 80 characters" ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0) Exit Sub End If @@ -121,12 +88,12 @@ Private Sub validate(ByVal rowNum As Long) hValue = Trim(ws.Cells(rowNum, 8).Value) If hValue <> "" Then If Len(hValue) <> 1 Then - ws.Cells(rowNum, 2).Value = "H column must be 1 digit" + ws.Cells(rowNum, errorCol).Value = "H column must be 1 digit" ws.Cells(rowNum, 8).Interior.Color = RGB(255, 0, 0) Exit Sub End If If hValue <> "0" And hValue <> "1" Then - ws.Cells(rowNum, 2).Value = "H column must be 0 or 1" + ws.Cells(rowNum, errorCol).Value = "H column must be 0 or 1" ws.Cells(rowNum, 8).Interior.Color = RGB(255, 0, 0) Exit Sub End If @@ -135,47 +102,10 @@ Private Sub validate(ByVal rowNum As Long) Dim iValue As String iValue = Trim(ws.Cells(rowNum, 9).Value) If iValue <> "" And Len(iValue) > 80 Then - ws.Cells(rowNum, 2).Value = "I column must be within 80 characters" + ws.Cells(rowNum, errorCol).Value = "I column must be within 80 characters" ws.Cells(rowNum, 9).Interior.Color = RGB(255, 0, 0) Exit Sub End If - ws.Cells(rowNum, 2).ClearContents + ws.Cells(rowNum, errorCol).ClearContents End Sub - -Private Sub validateButton() - Dim lastDataRow As Long, r As Long, errorCount As Long - lastDataRow = GetLastDataRowInRange(Me, START_COL, END_COL) - - If lastDataRow < 7 Then - MsgBox "No data found.", vbExclamation - Exit Sub - End If - - errorCount = 0 - For r = 7 To lastDataRow - Validate r - If Trim(Cells(r, ERROR_COL).Value) <> "" Then - errorCount = errorCount + 1 - End If - Next r - - ' === Refresh Z1 cache after validation passes === - If errorCount = 0 Then - Call RefreshZ1Cache - End If - - MsgBox "Validation complete. Errors: " & errorCount, vbInformation -End Sub - -Private Sub Do_Sort() - Call SortDataRows(3) -End Sub - -Private Sub Do_Filter() - Call ToggleAutoFilter(2, END_COL) -End Sub - -Private Sub Do_Fit() - Call AutoFitColumnWidth(2, END_COL) -End Sub \ No newline at end of file diff --git a/src/sheet/Z2.cls b/src/sheet/Z2.cls index dbe220d..54ca388 100644 --- a/src/sheet/Z2.cls +++ b/src/sheet/Z2.cls @@ -2,64 +2,31 @@ ' Module Name: Master_223 ' Module Desc: Z2 master data management (223) ' Module Methods: -' - Import -' - Export -' - SortData -' - ToggleAutoFilter +' - Validate ' ============================================================ -' ====== (223) ======= +' +Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long) -' ====== Constants ====== -Const START_COL As Long = 3 -Const END_COL As Long = 7 -Const ERROR_COL As Long = 2 + Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig() + Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName) -' ====== Function ====== -Private Sub Import() - Call Generic_Master_Import(Me, 5) -End Sub - -Private Sub Export() - Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(Me, START_COL, END_COL) + Dim startCol As String: startCol = sheetConf("StartCol") + Dim endCol As String: endCol = sheetConf("EndCol") + Dim errorCol As String: errorCol = sheetConf("ErrorCol") - If lastDataRow < 7 Then - MsgBox "No data rows to output.", vbExclamation - Exit Sub - End If - - Dim r As Long, errorCount As Long - For r = 7 To lastDataRow - Validate r - If Trim(Cells(r, 2).Value & "") <> "" Then - errorCount = errorCount + 1 - End If - Next r - - If errorCount > 0 Then - MsgBox "Validation failed. Found " & errorCount & " error(s). Please correct them before exporting.", vbCritical - Exit Sub - End If - - Call Generic_Master_Export(Me, 5, lastDataRow) -End Sub - -Private Sub validate(ByVal rowNum As Long) - Set ws = Me - Dim cValue As String: cValue = Trim(ws.Cells(rowNum, 3).Value) - ' clear C~I columns background color - Dim clearRange As Range - Set clearRange = ws.Range(ws.Cells(rowNum, START_COL), ws.Cells(rowNum, END_COL)) + Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol)) clearRange.Interior.Color = vbWhite + Dim cValue As String: cValue = Trim(ws.Cells(rowNum, 3).Value) If cValue = "" Then - ws.Cells(rowNum, 2).Value = "C column is required" + ws.Cells(rowNum, errorCol).Value = "C column is required" ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0) Exit Sub End If If Len(cValue) <> 3 Then - ws.Cells(rowNum, 2).Value = "C column must be 3 characters" + ws.Cells(rowNum, errorCol).Value = "C column must be 3 characters" ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0) Exit Sub End If @@ -69,7 +36,7 @@ Private Sub validate(ByVal rowNum As Long) For i = 1 To 3 ch = Mid(cValue, i, 1) If Not ((ch >= "0" And ch <= "9") Or (ch >= "A" And ch <= "Z") Or (ch >= "a" And ch <= "z")) Then - ws.Cells(rowNum, 2).Value = "C column must be alphanumeric" + ws.Cells(rowNum, errorCol).Value = "C column must be alphanumeric" ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0) Exit Sub End If @@ -78,12 +45,12 @@ Private Sub validate(ByVal rowNum As Long) Dim dValue As String dValue = Trim(ws.Cells(rowNum, 4).Value) If dValue = "" Then - ws.Cells(rowNum, 2).Value = "D column is required" + ws.Cells(rowNum, errorCol).Value = "D column is required" ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0) Exit Sub End If If Len(dValue) > 80 Then - ws.Cells(rowNum, 2).Value = "D column must be within 80 characters" + ws.Cells(rowNum, errorCol).Value = "D column must be within 80 characters" ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0) Exit Sub End If @@ -91,12 +58,12 @@ Private Sub validate(ByVal rowNum As Long) Dim eValue As String eValue = Trim(ws.Cells(rowNum, 5).Value) If eValue = "" Then - ws.Cells(rowNum, 2).Value = "E column is required" + ws.Cells(rowNum, errorCol).Value = "E column is required" ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0) Exit Sub End If If Len(eValue) > 80 Then - ws.Cells(rowNum, 2).Value = "E column must be within 80 characters" + ws.Cells(rowNum, errorCol).Value = "E column must be within 80 characters" ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0) Exit Sub End If @@ -104,7 +71,7 @@ Private Sub validate(ByVal rowNum As Long) Dim fValue As String fValue = Trim(ws.Cells(rowNum, 6).Value) If fValue <> "" And Len(fValue) > 80 Then - ws.Cells(rowNum, 2).Value = "F column must be within 80 characters" + ws.Cells(rowNum, errorCol).Value = "F column must be within 80 characters" ws.Cells(rowNum, 6).Interior.Color = RGB(255, 0, 0) Exit Sub End If @@ -113,53 +80,16 @@ Private Sub validate(ByVal rowNum As Long) hValue = Trim(ws.Cells(rowNum, 7).Value) If hValue <> "" Then If Len(hValue) <> 1 Then - ws.Cells(rowNum, 2).Value = "G column must be 1 digit" + ws.Cells(rowNum, errorCol).Value = "G column must be 1 digit" ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0) Exit Sub End If If hValue <> "0" And hValue <> "1" Then - ws.Cells(rowNum, 2).Value = "G column must be 0 or 1" + ws.Cells(rowNum, errorCol).Value = "G column must be 0 or 1" ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0) Exit Sub End If End If - ws.Cells(rowNum, 2).ClearContents + ws.Cells(rowNum, errorCol).ClearContents End Sub - -Private Sub validateButton() - Dim lastDataRow As Long, r As Long, errorCount As Long - lastDataRow = GetLastDataRowInRange(Me, START_COL, END_COL) - - If lastDataRow < 7 Then - MsgBox "No data found.", vbExclamation - Exit Sub - End If - - errorCount = 0 - For r = 7 To lastDataRow - Validate r - If Trim(Cells(r, ERROR_COL).Value) <> "" Then - errorCount = errorCount + 1 - End If - Next r - - ' === Refresh Z2 cache after validation passes === - If errorCount = 0 Then - Call RefreshZ2Cache - End If - - MsgBox "Validation complete. Errors: " & errorCount, vbInformation -End Sub - -Private Sub Do_Sort() - Call SortDataRows(3) -End Sub - -Private Sub Do_Filter() - Call ToggleAutoFilter(2, END_COL) -End Sub - -Private Sub Do_Fit() - Call AutoFitColumnWidth(2, END_COL) -End Sub \ No newline at end of file diff --git a/src/sheet/Z3.cls b/src/sheet/Z3.cls index 2b3cc31..d1abc0c 100644 --- a/src/sheet/Z3.cls +++ b/src/sheet/Z3.cls @@ -2,64 +2,30 @@ ' Module Name: Master_Z3_224 ' Module Desc: Z3 master data management (224) ' Module Methods: -' - Z3_Import -' - Z3_Export -' - Z3_SortDataRowsByC -' - Z3_ToggleAutoFilter +' - Validate ' ============================================================ -' ====== (224) ======= +' +Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long) + Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig() + Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName) -' ====== Constants ====== -Const START_COL As Long = 3 -Const END_COL As Long = 8 -Const ERROR_COL As Long = 2 - -' ====== Function ====== -Private Sub Import() - Call Generic_Master_Import(Me, 6) -End Sub - -Private Sub Export() - Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(Me, START_COL, END_COL) + Dim startCol As String: startCol = sheetConf("StartCol") + Dim endCol As String: endCol = sheetConf("EndCol") + Dim errorCol As String: errorCol = sheetConf("ErrorCol") - If lastDataRow < 7 Then - MsgBox "No data rows to output.", vbExclamation - Exit Sub - End If - - Dim r As Long, errorCount As Long - For r = 7 To lastDataRow - Validate r - If Trim(Cells(r, 2).Value & "") <> "" Then - errorCount = errorCount + 1 - End If - Next r - - If errorCount > 0 Then - MsgBox "Validation failed. Found " & errorCount & " error(s). Please correct them before exporting.", vbCritical - Exit Sub - End If - - Call Generic_Master_Export(Me, 6, lastDataRow) -End Sub - -Private Sub validate(ByVal rowNum As Long) - Set ws = Me - Dim cValue As String: cValue = Trim(ws.Cells(rowNum, 3).Value) - ' clear C~I columns background color - Dim clearRange As Range - Set clearRange = ws.Range(ws.Cells(rowNum, START_COL), ws.Cells(rowNum, END_COL)) + Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol)) clearRange.Interior.Color = vbWhite + Dim cValue As String: cValue = Trim(ws.Cells(rowNum, 3).Value) If cValue = "" Then - ws.Cells(rowNum, 2).Value = "C column is required" + ws.Cells(rowNum, endCol).Value = "C column is required" ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0) Exit Sub End If If Len(cValue) <> 3 Then - ws.Cells(rowNum, 2).Value = "C column must be 3 characters" + ws.Cells(rowNum, endCol).Value = "C column must be 3 characters" ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0) Exit Sub End If @@ -69,7 +35,7 @@ Private Sub validate(ByVal rowNum As Long) For i = 1 To 3 ch = Mid(cValue, i, 1) If Not ((ch >= "0" And ch <= "9") Or (ch >= "A" And ch <= "Z") Or (ch >= "a" And ch <= "z")) Then - ws.Cells(rowNum, 2).Value = "C column must be alphanumeric" + ws.Cells(rowNum, endCol).Value = "C column must be alphanumeric" ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0) Exit Sub End If @@ -78,12 +44,12 @@ Private Sub validate(ByVal rowNum As Long) Dim dValue As String dValue = Trim(ws.Cells(rowNum, 4).Value) If dValue = "" Then - ws.Cells(rowNum, 2).Value = "D column is required" + ws.Cells(rowNum, endCol).Value = "D column is required" ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0) Exit Sub End If If Len(dValue) > 80 Then - ws.Cells(rowNum, 2).Value = "D column must be within 80 characters" + ws.Cells(rowNum, endCol).Value = "D column must be within 80 characters" ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0) Exit Sub End If @@ -91,12 +57,12 @@ Private Sub validate(ByVal rowNum As Long) Dim eValue As String eValue = Trim(ws.Cells(rowNum, 5).Value) If eValue = "" Then - ws.Cells(rowNum, 2).Value = "E column is required" + ws.Cells(rowNum, endCol).Value = "E column is required" ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0) Exit Sub End If If Len(eValue) > 80 Then - ws.Cells(rowNum, 2).Value = "E column must be within 80 characters" + ws.Cells(rowNum, endCol).Value = "E column must be within 80 characters" ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0) Exit Sub End If @@ -104,7 +70,7 @@ Private Sub validate(ByVal rowNum As Long) Dim fValue As String fValue = Trim(ws.Cells(rowNum, 6).Value) If fValue <> "" And Len(fValue) > 80 Then - ws.Cells(rowNum, 2).Value = "F column must be within 80 characters" + ws.Cells(rowNum, endCol).Value = "F column must be within 80 characters" ws.Cells(rowNum, 6).Interior.Color = RGB(255, 0, 0) Exit Sub End If @@ -113,12 +79,12 @@ Private Sub validate(ByVal rowNum As Long) hValue = Trim(ws.Cells(rowNum, 7).Value) If hValue <> "" Then If Len(hValue) <> 1 Then - ws.Cells(rowNum, 2).Value = "G column must be 1 digit" + ws.Cells(rowNum, endCol).Value = "G column must be 1 digit" ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0) Exit Sub End If If hValue <> "0" And hValue <> "1" Then - ws.Cells(rowNum, 2).Value = "G column must be 0 or 1" + ws.Cells(rowNum, endCol).Value = "G column must be 0 or 1" ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0) Exit Sub End If @@ -127,47 +93,10 @@ Private Sub validate(ByVal rowNum As Long) Dim iValue As String iValue = Trim(ws.Cells(rowNum, 8).Value) If iValue <> "" And Len(iValue) > 80 Then - ws.Cells(rowNum, 2).Value = "H column must be within 80 characters" + ws.Cells(rowNum, endCol).Value = "H column must be within 80 characters" ws.Cells(rowNum, 8).Interior.Color = RGB(255, 0, 0) Exit Sub End If - ws.Cells(rowNum, 2).ClearContents + ws.Cells(rowNum, endCol).ClearContents End Sub - -Private Sub validateButton() - Dim lastDataRow As Long, r As Long, errorCount As Long - lastDataRow = GetLastDataRowInRange(Me, START_COL, END_COL) - - If lastDataRow < 7 Then - MsgBox "No data found.", vbExclamation - Exit Sub - End If - - errorCount = 0 - For r = 7 To lastDataRow - Validate r - If Trim(Cells(r, ERROR_COL).Value) <> "" Then - errorCount = errorCount + 1 - End If - Next r - - ' === Refresh Z3 cache after validation passes === - If errorCount = 0 Then - Call RefreshZ3Cache - End If - - MsgBox "Validation complete. Errors: " & errorCount, vbInformation -End Sub - -Private Sub Do_Sort() - Call SortDataRows(3) -End Sub - -Private Sub Do_Filter() - Call ToggleAutoFilter(2, END_COL) -End Sub - -Private Sub Do_Fit() - Call AutoFitColumnWidth(2, END_COL) -End Sub \ No newline at end of file diff --git a/src/sheet/Z4.cls b/src/sheet/Z4.cls index cc04163..8dd6531 100644 --- a/src/sheet/Z4.cls +++ b/src/sheet/Z4.cls @@ -2,64 +2,30 @@ ' Module Name: Master_Z4_220 ' Module Desc: Z4 master data management (220) ' Module Methods: -' - Z4_Import -' - Z4_Export -' - Z4_SortDataRowsByC -' - Z4_ToggleAutoFilter +' - Validate ' ============================================================ -' ====== (220) ======= +' +Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long) + Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig() + Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName) -' ====== Constants ====== -Const START_COL As Long = 3 -Const END_COL As Long = 9 -Const ERROR_COL As Long = 2 - -' ====== Function ====== -Private Sub Import() - Call Generic_Master_Import(Me, 7) -End Sub - -Private Sub Export() - Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(Me, START_COL, END_COL) + Dim startCol As String: startCol = sheetConf("StartCol") + Dim endCol As String: endCol = sheetConf("EndCol") + Dim errorCol As String: errorCol = sheetConf("ErrorCol") - If lastDataRow < 7 Then - MsgBox "No data rows to output.", vbExclamation - Exit Sub - End If - - Dim r As Long, errorCount As Long - For r = 7 To lastDataRow - Validate r - If Trim(Cells(r, 2).Value & "") <> "" Then - errorCount = errorCount + 1 - End If - Next r - - If errorCount > 0 Then - MsgBox "Validation failed. Found " & errorCount & " error(s). Please correct them before exporting.", vbCritical - Exit Sub - End If - - Call Generic_Master_Export(Me, 7, lastDataRow) -End Sub - -Private Sub validate(ByVal rowNum As Long) - Set ws = Me - Dim cValue As String: cValue = Trim(ws.Cells(rowNum, 3).Value) - ' clear C~I columns background color - Dim clearRange As Range - Set clearRange = ws.Range(ws.Cells(rowNum, START_COL), ws.Cells(rowNum, END_COL)) + Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol)) clearRange.Interior.Color = vbWhite + Dim cValue As String: cValue = Trim(ws.Cells(rowNum, 3).Value) If cValue = "" Then - ws.Cells(rowNum, 2).Value = "C column is required" + ws.Cells(rowNum, errorCol).Value = "C column is required" ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0) Exit Sub End If If Len(cValue) <> 3 Then - ws.Cells(rowNum, 2).Value = "C column must be 3 characters" + ws.Cells(rowNum, errorCol).Value = "C column must be 3 characters" ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0) Exit Sub End If @@ -69,7 +35,7 @@ Private Sub validate(ByVal rowNum As Long) For i = 1 To 3 ch = Mid(cValue, i, 1) If Not ((ch >= "0" And ch <= "9") Or (ch >= "A" And ch <= "Z") Or (ch >= "a" And ch <= "z")) Then - ws.Cells(rowNum, 2).Value = "C column must be alphanumeric" + ws.Cells(rowNum, errorCol).Value = "C column must be alphanumeric" ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0) Exit Sub End If @@ -78,12 +44,12 @@ Private Sub validate(ByVal rowNum As Long) Dim dValue As String dValue = Trim(ws.Cells(rowNum, 4).Value) If dValue = "" Then - ws.Cells(rowNum, 2).Value = "D column is required" + ws.Cells(rowNum, errorCol).Value = "D column is required" ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0) Exit Sub End If If Len(dValue) > 80 Then - ws.Cells(rowNum, 2).Value = "D column must be within 80 characters" + ws.Cells(rowNum, errorCol).Value = "D column must be within 80 characters" ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0) Exit Sub End If @@ -91,12 +57,12 @@ Private Sub validate(ByVal rowNum As Long) Dim eValue As String eValue = Trim(ws.Cells(rowNum, 5).Value) If eValue = "" Then - ws.Cells(rowNum, 2).Value = "E column is required" + ws.Cells(rowNum, errorCol).Value = "E column is required" ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0) Exit Sub End If If Len(eValue) > 80 Then - ws.Cells(rowNum, 2).Value = "E column must be within 80 characters" + ws.Cells(rowNum, errorCol).Value = "E column must be within 80 characters" ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0) Exit Sub End If @@ -104,7 +70,7 @@ Private Sub validate(ByVal rowNum As Long) Dim fValue As String fValue = Trim(ws.Cells(rowNum, 6).Value) If fValue <> "" And Len(fValue) > 80 Then - ws.Cells(rowNum, 2).Value = "F column must be within 80 characters" + ws.Cells(rowNum, errorCol).Value = "F column must be within 80 characters" ws.Cells(rowNum, 6).Interior.Color = RGB(255, 0, 0) Exit Sub End If @@ -113,12 +79,12 @@ Private Sub validate(ByVal rowNum As Long) hValue = Trim(ws.Cells(rowNum, 7).Value) If hValue <> "" Then If Len(hValue) <> 1 Then - ws.Cells(rowNum, 2).Value = "G column must be 1 digit" + ws.Cells(rowNum, errorCol).Value = "G column must be 1 digit" ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0) Exit Sub End If If hValue <> "0" And hValue <> "1" Then - ws.Cells(rowNum, 2).Value = "G column must be 0 or 1" + ws.Cells(rowNum, errorCol).Value = "G column must be 0 or 1" ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0) Exit Sub End If @@ -127,47 +93,10 @@ Private Sub validate(ByVal rowNum As Long) Dim iValue As String iValue = Trim(ws.Cells(rowNum, 8).Value) If iValue <> "" And Len(iValue) > 80 Then - ws.Cells(rowNum, 2).Value = "H column must be within 80 characters" + ws.Cells(rowNum, errorCol).Value = "H column must be within 80 characters" ws.Cells(rowNum, 8).Interior.Color = RGB(255, 0, 0) Exit Sub End If - ws.Cells(rowNum, 2).ClearContents + ws.Cells(rowNum, errorCol).ClearContents End Sub - -Private Sub validateButton() - Dim lastDataRow As Long, r As Long, errorCount As Long - lastDataRow = GetLastDataRowInRange(Me, START_COL, END_COL) - - If lastDataRow < 7 Then - MsgBox "No data found.", vbExclamation - Exit Sub - End If - - errorCount = 0 - For r = 7 To lastDataRow - Validate r - If Trim(Cells(r, ERROR_COL).Value) <> "" Then - errorCount = errorCount + 1 - End If - Next r - - ' === Refresh Z4 cache after validation passes === - If errorCount = 0 Then - Call RefreshZ4Cache - End If - - MsgBox "Validation complete. Errors: " & errorCount, vbInformation -End Sub - -Private Sub Do_Sort() - Call SortDataRows(3) -End Sub - -Private Sub Do_Filter() - Call ToggleAutoFilter(2, END_COL) -End Sub - -Private Sub Do_Fit() - Call AutoFitColumnWidth(2, END_COL) -End Sub \ No newline at end of file diff --git a/test.xlsm b/test.xlsm deleted file mode 100644 index ef73ca4..0000000 Binary files a/test.xlsm and /dev/null differ diff --git a/test.xlsx b/test.xlsx deleted file mode 100644 index cd387d8..0000000 Binary files a/test.xlsx and /dev/null differ diff --git a/通勤手当テンプレート_案.xlsm b/通勤手当テンプレート_案.xlsm index c0291d5..38f7522 100644 Binary files a/通勤手当テンプレート_案.xlsm and b/通勤手当テンプレート_案.xlsm differ