diff --git a/src/thisWorkbook/Master_M1_Kukan.bas b/src/thisWorkbook/Master_M1_Kukan.bas index cd54ef4..8b0bf1b 100644 --- a/src/thisWorkbook/Master_M1_Kukan.bas +++ b/src/thisWorkbook/Master_M1_Kukan.bas @@ -6,21 +6,48 @@ Const END_COL As Long = 14 ' N column Const ERROR_COL As Long = 15 ' O column Private z1Cache As Object ' Z1 cache +Private enumCache As Object ' Z1 cache ' ====== Function ====== Public Sub RefreshZ1Cache() + On Error GoTo RefreshError Set z1Cache = LoadLookup("Z1", keyCol:=3, valueCols:=Array(4), startRow:=7) + On Error GoTo 0 + + If z1Cache Is Nothing Or z1Cache.Count = 0 Then + Err.Raise 1001, "RefreshZ1Cache", "Z1 reference data is empty" + End If + + Exit Sub + +RefreshError: + Err.Raise 1002, "RefreshZ1Cache", "Failed to load Z1 lookup cache: " & Err.Description +End Sub + +Public Sub RefreshEnumCache() + On Error GoTo RefreshError + Set tokubetuKbn = LoadLookup("Enum", keyCol:=3, valueCols:=Array(3), startRow:=3) + On Error GoTo 0 + + If tokubetuKbn Is Nothing Or tokubetuKbn.Count = 0 Then + Err.Raise 1003, "RefreshZ1Cache", "Enum reference data is empty" + End If + + Exit Sub + +RefreshError: + Err.Raise 1001, "RefreshZ1Cache", "Failed to load Z1 lookup cache: " & Err.Description End Sub ' Get CSV header from row 5 (columns C to N) Function GetM1CSVHeader(ByVal ws As Worksheet) As Variant Dim headerArr(1 To 1, 1 To 12) As String Dim i As Long - + For i = 1 To 12 headerArr(1, i) = Trim(ws.Cells(5, i + 2).Value) ' i+2: 1→3(C), 12→14(N) Next i - + GetM1CSVHeader = headerArr End Function @@ -59,7 +86,7 @@ Sub FillFromZ1(ByVal rowNum As Long) If z1Cache.Exists(code) Then Dim vals As Variant: vals = z1Cache(code) - + ws.Cells(rowNum, 4).Value = vals(0) ws.Cells(rowNum, 5).Value = vals(1) Else @@ -80,48 +107,48 @@ Sub M1_Import() Dim csvData As Variant Dim i As Long Dim writeRow As Long - + ' Target this worksheet Set wsTarget = Me - + ' === 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) === On Error GoTo ImportError csvData = ReadCSVAs2DArrayStrict(filePath, 12, "shift_jis", False) On Error GoTo 0 - + ' === Clear all data rows before import === Dim lastRow As Long lastRow = wsTarget.Cells(wsTarget.Rows.Count, "C").End(xlUp).Row If lastRow >= 7 Then wsTarget.Range("A7:N" & lastRow).ClearContents End If - + If UBound(csvData, 1) < 1 Then MsgBox "No data in CSV.", vbExclamation Exit Sub End If - + ' === Step 3: Write CSV data to worksheet (forward order) === writeRow = 7 - + For i = LBound(csvData, 1) To UBound(csvData, 1) ' CSV col 1-12 -> C-N column Dim j As Long For j = 1 To 12 wsTarget.Cells(writeRow, j + 2).Value = CleanCSVField(CStr(csvData(i, j))) Next j - + ' Auto-fill D, E columns from Z1 Call FillFromZ1(writeRow) - + writeRow = writeRow + 1 Next i - + MsgBox writeRow - 7 & " rows imported.", vbInformation Exit Sub @@ -170,8 +197,7 @@ Sub validate(ByVal rowNum As Long, ByVal lastDataRow As Long) ' Check D and E column in the cache If z1Cache Is Nothing Then Call RefreshZ1Cache - If z1Cache Is Nothing Then Exit Sub - + Dim dValue As String: dValue = Trim(ws.Range("D" & rowNum).Value) Dim eValue As String: eValue = Trim(ws.Range("E" & rowNum).Value) @@ -186,26 +212,35 @@ Sub validate(ByVal rowNum As Long, ByVal lastDataRow As Long) ws.Cells(rowNum, ERROR_COL).Value = "Invalid reference data for D column." Exit Sub End If - + Dim expectedEValue As String expectedEValue = Trim(CStr(valueArray(0))) - + If eValue <> expectedEValue Then ws.Cells(rowNum, ERROR_COL).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 cache + If enumCache Is Nothing Then Call RefreshEnumCache + Dim lValue As String: lValue = Trim(ws.Range("L" & rowNum).Value) + If Not enumCache.Exists(lValue) Then + ws.Cells(rowNum, ERROR_COL).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 End Sub - -Sub validateButton() +' Validate button +Sub M1_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 @@ -217,7 +252,7 @@ Sub validateButton() errorCount = errorCount + 1 End If Next r - + MsgBox "Validation complete. Errors: " & errorCount, vbInformation End Sub @@ -230,7 +265,7 @@ Sub M1_Export() Dim ws As Worksheet Set ws = Me - + ' === Step 1: Validate all rows before export === Dim r As Long, errorCount As Long For r = 7 To lastDataRow @@ -241,39 +276,39 @@ Sub M1_Export() End If 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: Get header from row 5 (C-N columns) === Dim headerArr As Variant headerArr = GetM1CSVHeader(ws) - + ' === Step 4: Build data array (skip D, E, F columns) === Dim dataArr As Variant Dim rowCount As Long rowCount = 0 - + For r = 7 To lastDataRow If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then rowCount = rowCount + 1 End If Next r - + If rowCount = 0 Then MsgBox "No data rows to output.", vbExclamation Exit Sub End If - + ReDim dataArr(1 To rowCount, 1 To 12) - + Dim dataRow As Long dataRow = 0 For r = 7 To lastDataRow @@ -288,17 +323,17 @@ Sub M1_Export() Next j End If Next r - + ' === Step 5: Write to CSV (using common function) === Dim outputArr As Variant ReDim outputArr(1 To rowCount + 1, 1 To 12) - + ' Copy header to first row Dim colIdx As Long For colIdx = 1 To 12 outputArr(1, colIdx) = headerArr(1, colIdx) Next colIdx - + ' Copy data to remaining rows Dim dataR As Long For dataR = 1 To rowCount @@ -306,11 +341,11 @@ Sub M1_Export() outputArr(dataR + 1, colIdx) = dataArr(dataR, colIdx) Next colIdx Next dataR - + 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 @@ -323,9 +358,9 @@ Sub M1_SortDataRowsByC() End Sub Sub M1_ToggleAutoFilter() - Call ToggleAutoFilter(3, 14) + Call ToggleAutoFilter(START_COL, END_COL) End Sub Sub M1_AutoFitColumnWidth() - Call AutoFitColumnWidth(3, 14) + Call AutoFitColumnWidth(START_COL, END_COL) End Sub \ No newline at end of file diff --git a/通勤手当テンプレート_案.xlsm b/通勤手当テンプレート_案.xlsm index a304f4a..4fa17af 100644 Binary files a/通勤手当テンプレート_案.xlsm and b/通勤手当テンプレート_案.xlsm differ