diff --git a/src/module/Generic_Master_Common.bas b/src/module/Generic_Master_Common.bas index 023f302..f9cd158 100644 --- a/src/module/Generic_Master_Common.bas +++ b/src/module/Generic_Master_Common.bas @@ -2,25 +2,21 @@ ' Generic Master Common Functions ' ============================================================ Sub Generic_Master_Import(ByVal ws As Worksheet, ByVal expectedColumnCount As Long) - Dim filePath As String - Dim lines As Variant - Dim i As Long - Dim writeRow As Long - On Error GoTo ErrorHandler ' Step 1: Select CSV file - filePath = SelectCSVFile() + Dim filePath As String: filePath = SelectCSVFile() If filePath = "" Then Exit Sub ' Step 2: Read CSV and return 2D array - lines = ReadCSVAs2DArrayStrict(filePath, expectedColumnCount, "utf-8") + 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 - writeRow = 7 + 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 @@ -41,18 +37,12 @@ ErrorHandler: End Sub Sub Generic_Master_Export(ByVal ws As Worksheet, ByVal expectedColumnCount As Long, ByVal lastDataRow As Long) - Dim savePath As String - Dim r As Long - Dim rowCount As Long - Dim dataArray() As Variant - Dim dataIdx As Long - Dim j As Long - - savePath = GetSaveCSVPath() + Dim savePath As String: savePath = GetSaveCSVPath() If savePath = "" Then Exit Sub ' Count valid rows first (C column non-empty from row 7 onward) - rowCount = 0 + 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 @@ -66,10 +56,12 @@ Sub Generic_Master_Export(ByVal ws As Worksheet, ByVal expectedColumnCount As Lo 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 - dataIdx = 0 + 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 diff --git a/src/thisWorkbook/Master_M1_Kukan.bas b/src/thisWorkbook/Master_M1_Kukan.bas index 6f195bb..ef63b38 100644 --- a/src/thisWorkbook/Master_M1_Kukan.bas +++ b/src/thisWorkbook/Master_M1_Kukan.bas @@ -13,11 +13,11 @@ 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: @@ -29,11 +29,11 @@ Public Sub RefreshEnumCache() Set tokubetuKbn = LoadLookup("Enum", keyCol:=1, valueCols:=Array(1), startRow:=3) Set enumCache = tokubetuKbn On Error GoTo 0 - + If enumCache Is Nothing Or enumCache.Count = 0 Then Err.Raise 1003, "RefreshEnumCache", "Enum reference data is empty" End If - + Exit Sub RefreshError: @@ -46,7 +46,7 @@ Private Sub CreateEnumDropdown(ByVal rowNum As Long) ' Build dropdown list from enumCache keys Dim dropdownList As String dropdownList = "" - + Dim key As Variant For Each key In enumCache.Keys If dropdownList = "" Then @@ -55,7 +55,7 @@ Private Sub CreateEnumDropdown(ByVal rowNum As Long) dropdownList = dropdownList & "," & key End If Next key - + With Me.Range("L" & rowNum).Validation .Delete .Add Type:=xlValidateList, Formula1:=dropdownList @@ -64,18 +64,24 @@ Private Sub CreateEnumDropdown(ByVal rowNum As Long) .InputTitle = "" .InputMessage = "" End With - + 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 - + Dim cellValue As String + For i = 1 To 12 - headerArr(1, i) = Trim(ws.Cells(5, i + 2).Value) ' i+2: 1→3(C), 12→14(N) + cellValue = Trim(ws.Cells(5, i + 2).Value) ' i+2: 1→3(C), 12→14(N) + ' Remove line breaks + cellValue = Replace(cellValue, vbLf, "") + cellValue = Replace(cellValue, vbCr, "") + cellValue = Replace(cellValue, vbCrLf, "") + headerArr(1, i) = cellValue Next i - + GetM1CSVHeader = headerArr End Function @@ -92,7 +98,7 @@ Private Sub Worksheet_Change(ByVal Target As Range) End If Next End If - + ' === Column D changes: Fill E column === If Target.Column = 4 And Target.Row >= 7 Then If z1Cache Is Nothing Then Call RefreshZ1Cache @@ -114,35 +120,6 @@ Private Sub Worksheet_Change(ByVal Target As Range) End If End Sub -Sub FillFromZ1(ByVal rowNum As Long) - Dim ws As Worksheet: Set ws = ActiveSheet - Dim code As String: code = Trim(ws.Cells(rowNum, 3).Value) - If code = "" Then - Call ClearRowData(ws, rowNum) - Exit Sub - End If - - If z1Cache Is Nothing Then Call RefreshZ1Cache - If z1Cache Is Nothing Then Exit Sub - - 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 - Call ClearRowData(ws, rowNum) - End If -End Sub - - -Sub ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long) - ' Clear columns D onwards - ws.Range(ws.Cells(rowNum, 4), ws.Cells(rowNum, 15)).ClearContents - ws.Cells(rowNum, 6).Validation.Delete - ws.Cells(rowNum, ERROR_COL).ClearContents ' Column Q - error info -End Sub - Sub M1_Import() Dim wsTarget As Worksheet: Set wsTarget = Me @@ -161,7 +138,9 @@ Sub M1_Import() 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 ' === Step 3: Write CSV data to worksheet (forward order) === Dim i As Long @@ -223,7 +202,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 - + Dim dValue As String: dValue = Trim(ws.Range("D" & rowNum).Value) Dim eValue As String: eValue = Trim(ws.Range("E" & rowNum).Value) @@ -257,7 +236,7 @@ Sub validate(ByVal rowNum As Long, ByVal lastDataRow As Long) 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 @@ -295,11 +274,9 @@ Sub M1_Export() ' === Step 1: Validate all rows before export === Dim r As Long, errorCount As Long For r = 7 To lastDataRow - If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then - Call validate(r, lastDataRow) - If Trim(ws.Cells(r, ERROR_COL).Value) <> "" Then - errorCount = errorCount + 1 - End If + Call validate(r, lastDataRow) + If Trim(ws.Cells(r, ERROR_COL).Value) <> "" Then + errorCount = errorCount + 1 End If Next r @@ -312,61 +289,31 @@ Sub M1_Export() Dim savePath As String savePath = GetSaveCSVPath() If savePath = "" Then Exit Sub - - ' === Step 3: Get header from row 5 (C-N columns) === + + ' === Step 3: Count data rows === + Dim rowCount As Long: rowCount = lastDataRow - 6 + + ' === Step 4: Build array with header and data === 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 - If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then - dataRow = dataRow + 1 - ' CSV col1 -> C column - dataArr(dataRow, 1) = CleanCSVField(ws.Cells(r, 3).Value) - ' CSV col2-12 -> G-N column (columns 7-14) - Dim j As Long - For j = 7 To 14 - dataArr(dataRow, j - 6) = CleanCSVField(ws.Cells(r, j).Value) - 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 + ' Row 1: header 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 + ' Rows 2+: data (C-N columns) + Dim dataRow As Long: dataRow = 2 + For r = 7 To lastDataRow For colIdx = 1 To 12 - outputArr(dataR + 1, colIdx) = dataArr(dataR, colIdx) + outputArr(dataRow, colIdx) = CleanCSVField(ws.Cells(r, colIdx + 2).Value) Next colIdx - Next dataR + dataRow = dataRow + 1 + Next r On Error GoTo ExportError Call WriteCSVFromArray(savePath, outputArr, "shift_jis", False) diff --git a/通勤手当テンプレート_案.xlsm b/通勤手当テンプレート_案.xlsm index 050897b..49bbad1 100644 Binary files a/通勤手当テンプレート_案.xlsm and b/通勤手当テンプレート_案.xlsm differ