m2 update

2026-04-16 14:22:11 +09:00
parent a2ea02f36d
commit c39b8da85e
6 changed files with 255 additions and 317 deletions
--- a/src/data/区間詳細.csv
+++ b/src/data/区間詳細.csv
@@ -0,0 +1,20 @@
+利用区間コード,券種,コード,名称,1箇月運賃/販売額,定期額/券１(額)/利用額,定期支給期間/券１(枚)/特別料金,特別料金/券２(額),券２(枚),端数(額),特別料金
+00001,1,003,６箇月定期,7920,47520,6,,,,
+00001,2,001,テスト,15000,0,0,0,0,0,
+00001,3,001,プリペイドカード,20000,20000,,,,,
+00002,1,003,６箇月定期,1451.833,8711,6,,,,
+00002,2,001,テスト,15000,0,0,0,0,0,
+00002,3,002,0002テスト,45000,60000,,,,,
+00003,2,002,テスト2,500,500,10,500,10,0,
+00004,3,003,0004テスト,5000,5000,,,,,
+00005,1,003,６箇月定期,4753.333,28520,6,,,,
+00006,1,001,１箇月定期,7920,7920,1,,,,
+00006,1,003,６箇月定期,7920,47520,6,,,,
+00021,1,001,１箇月定期,6260,6260,1,,,,
+00038,1,001,１箇月定期,6260,6260,1,,,,
+00056,1,003,６箇月定期,10030,10030,1,,,,
+00067,1,003,６箇月定期,4486.666,26920,6,,,,
+00068,1,003,６箇月定期,52800,316800,6,,,,
+00069,1,006,６箇月,7181.666,43090,6,,,,
+00070,1,003,６箇月定期,6426.666,38560,6,,,,
+00071,1,003,６箇月定期,6879,6879,1,,,,
--- a/src/module/Module_Common.bas
+++ b/src/module/Module_Common.bas
@@ -2,6 +2,25 @@
 ' 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
+    Dim colCount As Long: colCount = UBound(colLetters) - LBound(colLetters) + 1
+    Dim headerArr() As String
+    ReDim headerArr(1 To 1, 1 To colCount)
+    
+    Dim i As Long
+    Dim cellValue As String
+    For i = 0 To colCount - 1
+        cellValue = Trim(ws.Cells(headerRow, Columns(colLetters(i)).Column).Value)
+        cellValue = Replace(cellValue, vbLf, "")
+        cellValue = Replace(cellValue, vbCr, "")
+        cellValue = Replace(cellValue, vbCrLf, "")
+        headerArr(1, i + 1) = cellValue
+    Next i
+    
+    GetCSVHeader = headerArr
+End Function
+
 Function CleanCSVField(ByVal inputStr As String) As String
    Dim s As String
    s = Trim(inputStr)
@@ -145,7 +164,9 @@ Function ClearDataRows(ByVal ws As Worksheet, ByVal startCol As Long, ByVal endC
    Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(ws, startCol, endCol, startRow)

    If lastDataRow >= startRow Then
-        ws.Range(ws.Cells(startRow, startCol), ws.Cells(lastDataRow, endCol)).ClearContents
+        Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(startRow, startCol), ws.Cells(lastDataRow, endCol))
+        clearRange.ClearContents
+        clearRange.Interior.Color = vbWhite
    End If
 End Function

--- a/src/module/Read_Common.bas
+++ b/src/module/Read_Common.bas
@@ -49,7 +49,7 @@ Function ReadCSVAs2DArrayStrict( _
        .Close
    End With

-    ' === stardand ===
+    ' === standardize ===
    textContent = Replace(textContent, vbCrLf, vbLf)
    textContent = Replace(textContent, vbCr, vbLf)

@@ -135,6 +135,10 @@ Private Function ParseCSVLines(ByVal csvText As String) As Collection
                    currentField = currentField & c
                    i = i + 1
                Else
+                    ' Clean field before adding
+                    currentField = Trim(currentField)
+                    currentField = Replace(currentField, vbCr, "")
+                    currentField = Replace(currentField, vbLf, "")
                    currentRow.Add currentField
                    currentField = ""
                    i = i + 1
@@ -167,6 +171,10 @@ Private Function ParseCSVLines(ByVal csvText As String) As Collection
    
    ' Handle last row without trailing newline
    If currentField <> "" Or currentRow.Count > 0 Then
+        ' Clean field before adding
+        currentField = Trim(currentField)
+        currentField = Replace(currentField, vbCr, "")
+        currentField = Replace(currentField, vbLf, "")
        currentRow.Add currentField
        Dim lastArr() As String
        If currentRow.Count > 0 Then
--- a/src/thisWorkbook/Master_M1_Kukan.bas
+++ b/src/thisWorkbook/Master_M1_Kukan.bas
@@ -1,13 +1,16 @@
-' ====== (222) =======
-
 ' ====== 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 START_COL As Long = 3   ' C column
+Const END_COL As Long = 14    ' N column
+Const ERROR_COL As Long = 15  ' O column
+Const M1_HEADER_ROW As Long = 5

 Private z1Cache As Object ' Z1 cache
 Private enumCache As Object ' Z1 cache

+Function HEADERS() As Variant
+    HEADERS = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N")
+End Function
+
 ' ====== Function ======
 Public Sub RefreshZ1Cache()
    On Error GoTo RefreshError
@@ -67,23 +70,6 @@ Private Sub CreateEnumDropdown(ByVal rowNum As Long)

 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
-        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

 Private Sub Worksheet_Change(ByVal Target As Range)
    ' === Column C changes: Create L column dropdown ===
@@ -121,11 +107,8 @@ Private Sub Worksheet_Change(ByVal Target As Range)
 End Sub

 Sub M1_Import()
-    Dim wsTarget As Worksheet: Set wsTarget = Me
-
    ' === Step 1: Select CSV file ===
-    Dim filePath As String
-    filePath = SelectCSVFile()
+    Dim filePath As String: filePath = SelectCSVFile()
    If filePath = "" Then Exit Sub

    ' === Step 2: Read CSV with Shift-JIS (using common function) ===
@@ -137,19 +120,22 @@ Sub M1_Import()
        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, END_COL, 7)
    Application.EnableEvents = True

-    ' === Step 3: Write CSV data to worksheet (forward order) ===
-    Dim i As Long
+    ' === 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 = 1 To 12
-            wsTarget.Cells(writeRow, j + 2).Value = CleanCSVField(CStr(csvData(i, j)))
+        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
@@ -268,10 +254,8 @@ Sub M1_Export()
        Exit Sub
    End If

-    Dim ws As Worksheet
-    Set ws = Me
-
    ' === 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)
@@ -286,8 +270,7 @@ Sub M1_Export()
    End If

    ' === Step 2: Select save path ===
-    Dim savePath As String
-    savePath = GetSaveCSVPath()
+    Dim savePath As String: savePath = GetSaveCSVPath()
    If savePath = "" Then Exit Sub
    
    ' === Step 3: Count data rows ===
@@ -295,22 +278,23 @@ Sub M1_Export()
    
    ' === Step 4: Build array with header and data ===
    Dim headerArr As Variant
-    headerArr = GetM1CSVHeader(ws)
+    Dim colLetters As Variant: colLetters = HEADERS()
+    headerArr = GetCSVHeader(ws, colLetters, M1_HEADER_ROW)

    Dim outputArr As Variant
    ReDim outputArr(1 To rowCount + 1, 1 To 12)

    ' Row 1: header
    Dim colIdx As Long
-    For colIdx = 1 To 12
-        outputArr(1, colIdx) = headerArr(1, colIdx)
+    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 = 1 To 12
-            outputArr(dataRow, colIdx) = CleanCSVField(ws.Cells(r, colIdx + 2).Value)
+        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
--- a/src/thisWorkbook/Master_M2_Kukan_detail.bas
+++ b/src/thisWorkbook/Master_M2_Kukan_detail.bas
@@ -1,5 +1,30 @@
-' CSV Header Constants
-Const CSV_HEADER As String = "利用区間コード,券種,コード,名称,1箇月運賃/販売額,定期額/券１(額)/利用額,定期支給期間/券１(枚)/特別料金,特別料金/券２(額),券２(枚),端数(額),特別料金"
+' ====== 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 M2_HEADER_ROW As Long = 6
+
+Private m1Cache As Object ' M1 cache
+
+Function HEADERS() As Variant
+    HEADERS = Array("C", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R")
+End Function
+
+' ====== Function ======
+Public Sub RefreshM1Cache()
+    On Error GoTo RefreshError
+    Set m1Cache = LoadLookup("M1", keyCol:=3, valueCols:=Array(4), startRow:=7)
+    On Error GoTo 0
+
+    If m1Cache Is Nothing Or m1Cache.Count = 0 Then
+        Err.Raise 1001, "RefreshM1Cache", "M1 reference data is empty"
+    End If
+
+    Exit Sub
+
+RefreshError:
+    Err.Raise 1002, "RefreshM1Cache", "Failed to load M1 lookup cache: " & Err.Description
+End Sub

 Private Sub Worksheet_Change(ByVal Target As Range)
    ' === Fill D, E when C column changes ===
@@ -9,13 +34,13 @@ Private Sub Worksheet_Change(ByVal Target As Range)
            If Trim(cell.Value) = "" Then
                Call ClearRowData(Me, cell.Row)
            Else
-                Call FillFromKukanMaster(Me, cell.Row)
+                Call FillFromM1(Me, cell.Row)
            End If
        Next
    End If
 End Sub

-Sub FillFromKukanMaster(ByVal ws As Worksheet, ByVal rowNum As Long, Optional ByVal setG As Boolean = True)
+Sub FillFromM1(ByVal ws As Worksheet, ByVal rowNum As Long, Optional ByVal setG As Boolean = True)
    Dim wsKukan As Worksheet
    Dim lastRow As Long
    Dim i As Long
@@ -54,310 +79,190 @@ Sub ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long)
    ws.Cells(rowNum, 19).ClearContents ' Q column error info
 End Sub

-Sub ImportMasterDetailData()
-    Dim filePath As String
-    Dim fileDialog As FileDialog
-    Dim wsTarget As Worksheet
-    Dim stream As Object
-    Dim textContent As String
-    Dim lines As Variant
-    Dim i As Long
-    Dim dataArray As Variant
-    Dim code As String
-    Dim lastRow As Long
-    Dim r As Long
-    ' Target this worksheet
-    Set wsTarget = Me
-    
+Sub M2_Import()
    ' === Step 1: Select CSV file ===
-    Set fileDialog = Application.FileDialog(msoFileDialogFilePicker)
-    With fileDialog
-        .Filters.Clear
-        .Filters.Add "CSV Files", "*.csv"
-        .AllowMultiSelect = False
-        If .Show <> -1 Then Exit Sub
-        filePath = .SelectedItems(1)
-    End With
+    Dim filePath As String: filePath = SelectCSVFile()
+    If filePath = "" Then Exit Sub

-    ' === Step 2: Read CSV with Shift-JIS ===
-    Set stream = CreateObject("ADODB.Stream")
-    With stream
-        .Type = 2
-        .Charset = "shift_jis"
-        .Open
-        .LoadFromFile filePath
-        textContent = .ReadText
-        .Close
-    End With
+    ' === 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

-    lines = Split(textContent, vbLf)
-    
-    ' === Validate CSV header ===
-    If UBound(lines) >= 0 And Trim(lines(0)) <> "" Then
-        Dim csvHeader As String
-        csvHeader = Trim(lines(0))
-        ' Validate column count
-        Dim expectedCount As Long
-        expectedCount = UBound(Split(CSV_HEADER, ",")) + 1
-        Dim headerFields As Variant
-        headerFields = Split(csvHeader, ",")
-        If UBound(headerFields) + 1 <> expectedCount Then
-            MsgBox "CSV column count mismatch. Expected: " & expectedCount & ", Got: " & UBound(headerFields) + 1, vbExclamation
-            Exit Sub
-        End If
-    End If
-    
-    ' === Clear all data rows before import ===
-    lastRow = wsTarget.Cells(wsTarget.Rows.Count, "C").End(xlUp).Row
-    If lastRow >= 7 Then
-        wsTarget.Range("A7:P" & lastRow).ClearContents
-    End If
-    
-    If UBound(lines) < 1 Then
+    If UBound(csvData, 1) < 1 Then
        MsgBox "No data in CSV.", vbExclamation
        Exit Sub
    End If
    
-    ' === Step 3: Collect CSV codes and data ===
-    Dim csvData As Object
-    Set csvData = CreateObject("Scripting.Dictionary")
-    
-    For i = 1 To UBound(lines)
-        If Trim(lines(i)) = "" Then GoTo NextCsvLine
-        dataArray = Split(lines(i), ",")
-        If UBound(dataArray) >= 0 Then
-            code = CleanCSVField(CStr(dataArray(0)))
-            If code <> "" Then
-                ' Use unique key: code + "_" + row index to avoid duplicate key error
-                csvData.Add code & "_" & i, dataArray
-            End If
-        End If
-NextCsvLine:
-    Next i
-    
-    If csvData.Count = 0 Then
-        MsgBox "No valid code found.", vbExclamation
-        Exit Sub
-    End If
-    
-    ' === Step 6: Write CSV data to next available row === 
-    writeRow = 7
-    
-    For i = 1 To UBound(lines)
-        If Trim(lines(i)) = "" Then GoTo NextLine
-        
-        dataArray = Split(lines(i), ",")
-        
-        ' CSV col 1 -> C column
-        code = CleanCSVField(CStr(dataArray(0)))
-        wsTarget.Cells(writeRow, 3).Value = code
-        
-        ' CSV col 2-11 -> G-P column
-        If UBound(dataArray) >= 1 Then wsTarget.Cells(writeRow, 9).Value = CleanCSVField(CStr(dataArray(1)))
-        If UBound(dataArray) >= 2 Then wsTarget.Cells(writeRow, 10).Value = CleanCSVField(CStr(dataArray(2)))
-        If UBound(dataArray) >= 3 Then wsTarget.Cells(writeRow, 11).Value = CleanCSVField(CStr(dataArray(3)))
-        If UBound(dataArray) >= 4 Then wsTarget.Cells(writeRow, 12).Value = CleanCSVField(CStr(dataArray(4)))
-        If UBound(dataArray) >= 5 Then wsTarget.Cells(writeRow, 13).Value = CleanCSVField(CStr(dataArray(5)))
-        If UBound(dataArray) >= 6 Then wsTarget.Cells(writeRow, 14).Value = CleanCSVField(CStr(dataArray(6)))
-        If UBound(dataArray) >= 7 Then wsTarget.Cells(writeRow, 15).Value = CleanCSVField(CStr(dataArray(7)))
-        If UBound(dataArray) >= 8 Then wsTarget.Cells(writeRow, 16).Value = CleanCSVField(CStr(dataArray(8)))
-        If UBound(dataArray) >= 9 Then wsTarget.Cells(writeRow, 17).Value = CleanCSVField(CStr(dataArray(9)))
-        If UBound(dataArray) >= 10 Then wsTarget.Cells(writeRow, 18).Value = CleanCSVField(CStr(dataArray(10)))
-        
-        ' Auto-fill D, E columns
-        Call FillFromKukanMaster(wsTarget, writeRow, False)
-        
-        ' G column has value → trigger F dropdown
-
+    ' === 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

+    ' === 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
-NextLine:
    Next i

    MsgBox writeRow - 7 & " rows imported.", vbInformation
+    Exit Sub
+
+ImportError:
+    MsgBox "CSV import failed: " & Err.Description, vbExclamation
 End Sub

-Function CleanCSVField(ByVal field As Variant) As String
-    If IsEmpty(field) Or IsNull(field) Then
-        CleanCSVField = ""
-        Exit Function
-    End If
+Sub validate(ByVal rowNum As Long, ByVal lastDataRow As Long)
+    Set ws = Me

-    Dim result As String
-    result = Trim(CStr(field))
+    Dim clearRange As Range
+    Set clearRange = ws.Range(ws.Cells(rowNum, START_COL), ws.Cells(rowNum, END_COL))
+    clearRange.Interior.Color = vbWhite

-    If Len(result) >= 2 Then
-        If Left(result, 1) = """" And Right(result, 1) = """" Then
-            result = Mid(result, 2, Len(result) - 2)
-            result = Replace(result, """""", """")
+    ' Check column required
+    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.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0)
+            Exit Sub
        End If
-    End If
-    CleanCSVField = result
-End Function
+    Next colLetter

-Sub validateDetailData(ByVal ws As Worksheet, ByVal rowNum As Long)
-    ' Check C column not empty
-    If Trim(ws.Cells(rowNum, 3).Value) = "" Then
-        ws.Cells(rowNum, 19).ClearContents
-        Exit Sub
-    End If
-    
-    ' Check G, H required and numeric (for composite key)
-    If Trim(ws.Cells(rowNum, 9).Value) = "" Or Not IsNumeric(ws.Cells(rowNum, 9).Value) Then
-        ws.Cells(rowNum, 19).Value = "G column (I) is required and must be numeric"
-        Exit Sub
-    End If
-    
-    If Trim(ws.Cells(rowNum, 10).Value) = "" Or Not IsNumeric(ws.Cells(rowNum, 10).Value) Then
-        ws.Cells(rowNum, 19).Value = "H column (J) is required and must be numeric"
-        Exit Sub
-    End If
-    
-    ' Check I (K column) required
-    If Trim(ws.Cells(rowNum, 11).Value) = "" Then
-        ws.Cells(rowNum, 19).Value = "I column (K) is required"
-        Exit Sub
-    End If
-    
-    ' Check J, K required and numeric
-    If Trim(ws.Cells(rowNum, 12).Value) = "" Or Not IsNumeric(ws.Cells(rowNum, 12).Value) Then
-        ws.Cells(rowNum, 19).Value = "J column (L) is required and must be numeric"
-        Exit Sub
-    End If
-    
-    If Trim(ws.Cells(rowNum, 13).Value) = "" Or Not IsNumeric(ws.Cells(rowNum, 13).Value) Then
-        ws.Cells(rowNum, 19).Value = "K column (M) is required and must be numeric"
-        Exit Sub
-    End If
-    
-    ' Check L-P optional but must be numeric if entered
-    Dim col As Long
-    Dim colName As String
-    Dim colLetter As String
-    colLetter = "NOPQR"
-    
-    For col = 14 To 18
-        If Trim(ws.Cells(rowNum, col).Value) <> "" And Not IsNumeric(ws.Cells(rowNum, col).Value) Then
-            colName = Mid(colLetter, col - 13, 1)
-            ws.Cells(rowNum, 19).Value = colName & " column must be numeric"
+    ' Check column numeric (only if has value)
+    Dim numericCols As Variant: numericCols = Array("L", "M", "N", "O", "P", "Q", "R")
+    Dim col As Variant
+    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.Range(col & rowNum).Interior.Color = RGB(255, 0, 0)
            Exit Sub
        End If
    Next col

-    ' Check GH composite key duplicate
-    Dim g As String, h As String
-    Dim r As Long
-    Dim lastRow As Long
+    ' Check C column in the cache
+    If m1Cache Is Nothing Then Call RefreshM1Cache
+    Dim dValue As String: dValue = Trim(ws.Range("C" & rowNum).Value)

-    g = Trim(ws.Cells(rowNum, 9).Value)
-    h = Trim(ws.Cells(rowNum, 10).Value)
+    If Not m1Cache.Exists(dValue) Then
+        ws.Cells(rowNum, ERROR_COL).Value = "C column does not exist in M1."
+        ws.Range("C" & rowNum).Interior.Color = RGB(255, 0, 0)
+        Exit Sub
+    End If

-    lastRow = ws.Cells(ws.Rows.Count, 3).End(xlUp).Row
+    ' Check I column in the kenshuKbn
+    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.Range("I" & rowNum).Interior.Color = RGB(255, 0, 0)
+        Exit Sub
+    End If

-    For r = 7 To lastRow
-        If r <> rowNum And Trim(ws.Cells(r, 3).Value) = Trim(ws.Cells(rowNum, 3).Value) Then
-            If Trim(ws.Cells(r, 9).Value) = g And Trim(ws.Cells(r, 10).Value) = h Then
-                ws.Cells(rowNum, 19).Value = "GH (I,J) combination already exists"
-                Exit Sub
-            End If
-        End If
-    Next r
-    
-    ' Validation passed
-    ws.Cells(rowNum, 19).ClearContents
 End Sub


 ' Button macro (Validate selected row)
-Sub validateDetailDataButton()
-    Dim ws As Worksheet
-    Dim lastRow As Long
-    Dim r As Long
-    Dim errorCount As Long
+Sub M2_validateButton()
+    Dim lastDataRow As Long, r As Long, errorCount As Long
+    lastDataRow = GetLastDataRowInRange(Me, START_COL, END_COL)

-    Set ws = ActiveSheet
-    lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
-    
-    If lastRow < 7 Then
+    If lastDataRow < 7 Then
        MsgBox "No data found.", vbExclamation
        Exit Sub
    End If

-    errorCount = 0
-    For r = 7 To lastRow
-        Call validateDetailData(ws, r)
-        If Trim(ws.Cells(r, 17).Value) <> "" Then
+    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
+    MsgBox "Validation complete. Errors: " & errorCount, vbInformation
 End Sub

-Sub ExportMasterDetailData()
-    Dim ws As Worksheet
-    Set ws = ActiveSheet
-    
-    Dim lastDataRow As Long
-    lastDataRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
-    
+Sub M2_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 savePath As String
-    savePath = Application.GetSaveAsFilename( _
-        FileFilter:="CSV Files (*.csv), *.csv", _
-        Title:="Save CSV")
-    
-    If savePath = "False" Then Exit Sub
-    If InStr(1, savePath, ".csv", vbTextCompare) = 0 Then
-        savePath = savePath & ".csv"
-    End If
-    
-    ' Build header from row 5 (columns C, G-P)
-    Dim csvContent As String
-    csvContent = Trim(ws.Cells(5, 3).Value)
-    Dim j As Long
-    For j = 7 To 16
-        csvContent = csvContent & "," & Trim(ws.Cells(5, j).Value)
-    Next j
-    csvContent = csvContent & vbLf
-    
-    ' Row counter
-    Dim rowCount As Long
-    rowCount = 0
-    
-    ' Data: C,G,H,I,J,K,L,M,N,O,P (skip D,E,F)
-    Dim r As Long
+    ' === 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
-        If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then
-            rowCount = rowCount + 1
-            ' CSV col1 -> C column
-            csvContent = csvContent & CleanCSVField(ws.Cells(r, 3).Value)
-            ' CSV col2-11 -> I-R column
-            For j = 9 To 18
-                csvContent = csvContent & "," & CleanCSVField(ws.Cells(r, j).Value)
-            Next j
-            csvContent = csvContent & vbLf
+        Call validate(r, lastDataRow)
+        If Trim(ws.Cells(r, ERROR_COL).Value) <> "" Then
+            errorCount = errorCount + 1
        End If
    Next r

-    ' Trim trailing empty lines
-    Do While Right(csvContent, 1) = vbLf
-        csvContent = Left(csvContent, Len(csvContent) - 1)
-    Loop
+    If errorCount > 0 Then
+        MsgBox "Validation failed. Found " & errorCount & " error(s). Please correct them before exporting.", vbCritical
+        Exit Sub
+    End If

-    ' Write file
-    Dim stream As Object
-    Set stream = CreateObject("ADODB.Stream")
-    stream.Type = 2
-    stream.Charset = "shift_jis"
-    stream.Open
-    stream.WriteText csvContent, 1
-    stream.SaveToFile savePath, 2
-    stream.Close
+    ' === 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, M2_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
+
+Sub M2_SortDataRowsByC()
+    Call SortDataRows(3)
+End Sub
+
+Sub M2_ToggleAutoFilter()
+    Call ToggleAutoFilter(START_COL, END_COL)
+End Sub
+
+Sub M2_AutoFitColumnWidth()
+    Call AutoFitColumnWidth(START_COL, END_COL)
 End Sub
--- a/通勤手当テンプレート_案.xlsm
+++ b/通勤手当テンプレート_案.xlsm