update Generic Master bas3

2026-04-15 10:42:48 +09:00
parent 41ac5eb9ef
commit d89fc2e8b1
12 changed files with 497 additions and 97 deletions
--- a/README.md
+++ b/README.md
@@ -1,2 +1,21 @@
-# vba
+## 项目结构

+```
+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) 
+```
--- a/src/data/222交通機関名区分.csv
+++ b/src/data/222交通機関名区分.csv
@@ -0,0 +1,3 @@
+"001","JR 東北線","JR 東北線","","JR 東北線","0",""
+"002","ＪＲ","ＪＲ","","ＪＲ","",""
+"003","山交バス","山交バス","","山交バス","",""
--- a/src/data/223通勤_決定事項区分.csv
+++ b/src/data/223通勤_決定事項区分.csv
@@ -0,0 +1,3 @@
+"1","法第１２条第１項 該当","法第１２条第１項 該当","",""
+"2","法第１２条第１項 該当（規則第５条）","法第１２条第１項 該当（規則第５条）","",""
+"3","法第１２条第１項 非該当","法第１２条第１項 非該当","",""
--- a/src/data/224通勤_手当月額の決定区分.csv
+++ b/src/data/224通勤_手当月額の決定区分.csv
@@ -0,0 +1,12 @@
+"10","法第１２条第２項第１号","法第１２条第２項第１号","","",""
+"20","法第１２条第２項第２号","法第１２条第２項第２号","","",""
+"30","法第１２条第２項第３号","法第１２条第２項第３号","","",""
+"31","法第１２条第２項第３号。","法第１２条第２項第３号　規則第８条の２第１号","","","規則第８条の２第１号"
+"32","法第１２条第２項第３号","法第１２条第２項第３号　規則第８条の２第２号","","","規則第８条の２第２号"
+"33","法第１２条第２項第３号","法第１２条第２項第３号　規則第８条の２第３号","","","規則第８条の２第３号"
+"40","法第１２条第３項","法第１２条第３項","","",""
+"41","法第１２条第３項第３号","法第１２条第３項第３号　規則第８条の３第１号","","","規則第８条の３第１号"
+"42","法第１２条第３項第３号","法第１２条第３項第３号　規則第８条の３第２号","","",""
+"50","法第１２条第４項","法第１２条第４項","","",""
+"60","法第１２条第５項","法第１２条第５項","","",""
+"90","非該当","非該当","","",""
--- a/src/data/507発信者.csv
+++ b/src/data/507発信者.csv
@@ -0,0 +1,2 @@
+"001","○○大学総長","○○大学総長","","","○○大学総長","○　○　○　○","000000","943901","","","","1"
+"002","○○大学医療技術短期大学部学長","○○大学医療技術短期大学部学長","","","○○大学医療技術短期大学部学長","○　○　○　○","607300","607300","","","","1"
--- a/src/data/区間.csv
+++ b/src/data/区間.csv
@@ -0,0 +1,75 @@
+利用区間コード,交通機関区分,交通機関名称,利用区間発名,利用区間着名,距離等,運賃,現金の場合の1箇月運賃,連絡,特別料金区分,特別料金の券種,特別料金の負担額
+00001,002,ＪＲ,芦川,甲府,22,2233,,,普通,,
+00002,002,ＪＲ,井土ヶ谷,甲府,,0,,,普通,,
+00003,002,ＪＲ,稲田堤,甲府,,0,,,普通,,
+00004,002,ＪＲ,猿橋,甲府,,0,,,普通,,
+00005,002,ＪＲ,塩崎,甲府,,0,,,普通,,
+00006,002,ＪＲ,塩山,甲府,,0,,,普通,,
+00007,002,ＪＲ,岡谷,甲府,,0,,,普通,,
+00008,002,ＪＲ,下部温泉,常永,,0,,,普通,,
+00009,002,ＪＲ,我孫子,甲府,,0,,,普通,,
+00010,002,ＪＲ,茅野,甲府,,0,,,普通,,
+00011,002,ＪＲ,久那土,小井川,,0,,,普通,,
+00012,002,ＪＲ,狭間,甲府,,0,,,普通,,
+00013,002,ＪＲ,金手,甲府,,0,,,普通,,
+00014,002,ＪＲ,穴山,甲府,,0,,,普通,,
+00015,002,ＪＲ,御茶ノ水,甲府,,0,,,普通,,
+00016,002,ＪＲ,御嶽山・目黒,永田町,,0,,,普通,,
+00017,002,ＪＲ,広丘,甲府,,0,,,普通,,
+00018,002,ＪＲ,甲斐岩間,甲府,,0,,,普通,,
+00019,002,ＪＲ,甲斐上野,甲府,,0,,,普通,,
+00020,002,ＪＲ,甲斐大和,甲府,,0,,,普通,,
+00021,002,ＪＲ,甲府,常永,,0,,,普通,,
+00022,002,ＪＲ,高尾,甲府,,0,,,普通,,
+00023,002,ＪＲ,国分寺,甲府,,0,,,普通,,
+00024,002,ＪＲ,国母,常永,,0,,,普通,,
+00025,002,ＪＲ,国母,甲府,,0,,,普通,,
+00026,002,ＪＲ,笹子,甲府,,0,,,普通,,
+00027,002,ＪＲ,三鷹,塩山,,0,,,普通,,
+00028,002,ＪＲ,山梨市,甲府,,0,,,普通,,
+00029,002,ＪＲ,市川本町,常永,,0,,,普通,,
+00030,002,ＪＲ,指扇,甲府,,0,,,普通,,
+00031,002,ＪＲ,若葉台,甲府,,0,,,普通,,
+00032,002,ＪＲ,酒折,甲府,,0,,,普通,,
+00033,002,ＪＲ,春日居町,甲府,,0,,,普通,,
+00034,002,ＪＲ,初狩,甲府,,0,,,普通,,
+00035,002,ＪＲ,小井川,甲府,,0,,,普通,,
+00036,002,ＪＲ,小淵沢,甲府,,0,,,普通,,
+00037,002,ＪＲ,松本,甲府,,0,,,普通,,
+00038,002,ＪＲ,常永,甲府,,0,,,普通,,
+00039,002,ＪＲ,新座,甲府,,0,,,普通,,
+00040,002,ＪＲ,新三郷,甲府,,0,,,普通,,
+00041,002,ＪＲ,新宿,常永,,0,,,普通,,
+00042,002,ＪＲ,新府,甲府,,0,,,普通,,
+00043,002,ＪＲ,聖蹟桜ヶ丘,甲府,,0,,,普通,,
+00044,002,ＪＲ,西荻窪,甲府,,0,,,普通,,
+00045,002,ＪＲ,西八王子,甲府,,0,,,普通,,
+00046,002,ＪＲ,石和温泉,甲府,,0,,,普通,,
+00047,002,ＪＲ,代々木,甲府,,0,,,普通,,
+00048,002,ＪＲ,代田橋,甲府,,0,,,普通,,
+00049,002,ＪＲ,大月,甲府,,0,,,普通,,
+00050,002,ＪＲ,池袋,甲府,,0,,,普通,,
+00051,002,ＪＲ,潮見～東京,新宿～甲府,,0,,,普通,,
+00052,002,ＪＲ,長後,甲府,,0,,,普通,,
+00053,002,ＪＲ,長坂,甲府,,0,,,普通,,
+00054,002,ＪＲ,東花輪,甲府,,0,,,普通,,
+00055,002,ＪＲ,東山梨,甲府,,0,,,普通,,
+00056,002,ＪＲ,東山梨→甲府,甲府→常永,,0,,,普通,,
+00057,002,ＪＲ,東所沢,甲府,,0,,,普通,,
+00058,002,ＪＲ,東船橋,甲府,,0,,,普通,,
+00059,002,ＪＲ,東飯能,甲府,,0,,,普通,,
+00060,002,ＪＲ,南甲府,甲府,,0,,,普通,,
+00061,002,ＪＲ,韮崎,甲府,,0,,,普通,,
+00062,002,ＪＲ,柏の葉キャンパス,甲府,,0,,,普通,,
+00063,002,ＪＲ,八王子,甲府,,0,,,普通,,
+00064,002,ＪＲ,豊田,甲府,,0,,,普通,,
+00065,002,ＪＲ,矢川,甲府,,0,,,普通,,
+00066,002,ＪＲ,立川,甲府,,0,,,普通,,
+00067,002,ＪＲ,竜王,甲府,,0,,,普通,,
+00068,002,ＪＲ,飯田橋,甲府,,0,,,普通,,
+00069,003,山交バス,甲府駅北口,山梨大学,,0,,,普通,,
+00070,002,ＪＲ,白金高輪駅,虎ノ門駅,20,2000,,,普通,,
+00071,003,山交バス,新貢川橋南,山梨大学,30,3000,,,普通,,
+00072,002,ＪＲ,芦川,甲府,1,2,3,,普通,,
+00073,001,交通用具,smart,smart,2222,222,2222,,普通,,
+00074,002,ＪＲ,甲府,甲府,22,2222,2222,,普通,,
--- a/src/thisWorkbook/Kukan_master.bas
+++ b/src/thisWorkbook/Kukan_master.bas
@@ -0,0 +1,345 @@
+' CSV Header Constants
+
+Private Sub Worksheet_Change(ByVal Target As Range)
+    ' === Fill D, E when C column changes ===
+    If Target.Column = 3 And Target.Row >= 7 Then
+        Dim cell As Range
+        For Each cell In Target
+            If Trim(cell.Value) = "" Then
+                Call ClearRowData(Me, cell.Row)
+            Else
+                Call FillFromKukanMaster(Me, cell.Row)
+            End If
+        Next
+    End If
+End Sub
+
+Sub FillFromZ1(ByVal ws As Worksheet, ByVal rowNum As Long, Optional ByVal setG As Boolean = True)
+    Dim wsZ1 As Worksheet
+    Dim lastRow As Long
+    Dim i As Long
+    Dim code As String
+    
+    On Error Resume Next
+    Set wsZ1 = ThisWorkbook.Worksheets("Z1")
+    If wsZ1 Is Nothing Then Exit Sub
+    On Error GoTo 0
+    code = Trim(ws.Cells(rowNum, 3).Value)
+    If code = "" Then Exit Sub
+    lastRow = wsZ1.Cells(wsZ1.rows.Count, 3).End(xlUp).Row
+    
+    For i = 7 To lastRow
+        If Trim(wsZ1.Cells(i, 7).Value) = code Then
+            ws.Cells(rowNum, 4).Value = Trim(wsZ1.Cells(i, 4).Value)
+            ws.Cells(rowNum, 4).Value = Trim(wsZ1.Cells(i, 4).Value)
+            ws.Cells(rowNum, 5).Value = Trim(wsZ1.Cells(i, 6).Value)
+            ws.Cells(rowNum, 6).Value = Trim(wsZ1.Cells(i, 7).Value)
+            ws.Cells(rowNum, 7).Value = Trim(wsZ1.Cells(i, 9).Value)
+            If setG Then
+                ws.Cells(rowNum, 7).Value = "1"
+            End If
+            Exit Sub
+        End If
+    Next
+    
+    Call ClearRowData(ws, rowNum)
+End Sub
+
+
+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
+
+Sub M1_Import()
+    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
+    
+    ' === 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
+    
+    ' === 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
+    
+    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
+        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
+
+        
+        writeRow = writeRow + 1
+NextLine:
+    Next i
+    
+    MsgBox writeRow - 7 & " rows imported.", vbInformation
+End Sub
+
+Sub validate(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"
+            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
+    
+    g = Trim(ws.Cells(rowNum, 9).Value)
+    h = Trim(ws.Cells(rowNum, 10).Value)
+    
+    lastRow = ws.Cells(ws.rows.Count, 3).End(xlUp).Row
+    
+    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 validateButton()
+    Dim ws As Worksheet
+    Dim lastRow As Long
+    Dim r As Long
+    Dim errorCount As Long
+    
+    Set ws = ActiveSheet
+    lastRow = ws.Cells(ws.rows.Count, "C").End(xlUp).Row
+    
+    If lastRow < 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
+            errorCount = errorCount + 1
+        End If
+    Next r
+    
+    MsgBox "Validation complete. Errors: " & errorCount & ", ", vbInformation
+End Sub
+
+Sub M1_Export()
+    Dim ws As Worksheet
+    Set ws = ActiveSheet
+    
+    Dim lastDataRow As Long
+    lastDataRow = ws.Cells(ws.rows.Count, "C").End(xlUp).Row
+    
+    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
+    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
+        End If
+    Next r
+    
+    ' Trim trailing empty lines
+    Do While Right(csvContent, 1) = vbLf
+        csvContent = Left(csvContent, Len(csvContent) - 1)
+    Loop
+    
+    ' 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
+    
+    MsgBox "CSV export completed. Total data rows: " & rowCount, vbInformation
+End Sub
+
--- a/src/thisWorkbook/Master_222.bas
+++ b/src/thisWorkbook/Master_222.bas
@@ -108,14 +108,6 @@ Sub Validate(ByVal rowNum As Long)
        Exit Sub
    End If
    
-    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, 9).Interior.Color = RGB(255, 0, 0)
-        Exit Sub
-    End If
-    
    Dim hValue As String
    hValue = Trim(ws.Cells(rowNum, 8).Value)
    If hValue <> "" Then
@@ -130,6 +122,14 @@ Sub Validate(ByVal rowNum As Long)
            Exit Sub
        End If
    End If
+
+    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, 9).Interior.Color = RGB(255, 0, 0)
+        Exit Sub
+    End If
    
    ws.Cells(rowNum, 2).ClearContents
 End Sub
--- a/src/thisWorkbook/Master_223.bas
+++ b/src/thisWorkbook/Master_223.bas
@@ -4,7 +4,7 @@ Sub Z2_ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long)
 End Sub

 Sub Z2_Import()
-    Call Generic_Master_Import(Me)
+    Call Generic_Master_Import(Me, 5)
 End Sub

 Sub Z2_Export()
@@ -29,7 +29,7 @@ Sub Z2_Export()
        Exit Sub
    End If

-    Call Generic_Master_Export(Me, 7, lastDataRow)
+    Call Generic_Master_Export(Me, 5, lastDataRow)
 End Sub

 Sub Validate(ByVal rowNum As Long)
@@ -40,7 +40,7 @@ Sub Validate(ByVal rowNum As Long)

    ' clear C~I columns background color
    Dim clearRange As Range
-    Set clearRange = ws.Range(ws.Cells(rowNum, 3), ws.Cells(rowNum, 9))
+    Set clearRange = ws.Range(ws.Cells(rowNum, 3), ws.Cells(rowNum, 7))
    clearRange.Interior.Color = vbWhite
    
    If cValue = "" Then
@@ -100,33 +100,17 @@ Sub Validate(ByVal rowNum As Long)
        Exit Sub
    End If
    
-    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, 7).Interior.Color = RGB(255, 0, 0)
-        Exit Sub
-    End If
-    
-    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, 9).Interior.Color = RGB(255, 0, 0)
-        Exit Sub
-    End If
-    
    Dim hValue As String
-    hValue = Trim(ws.Cells(rowNum, 8).Value)
+    hValue = Trim(ws.Cells(rowNum, 7).Value)
    If hValue <> "" Then
        If Len(hValue) <> 1 Then
-            ws.Cells(rowNum, 2).Value = "H column must be 1 digit"
-            ws.Cells(rowNum, 8).Interior.Color = RGB(255, 0, 0)
+            ws.Cells(rowNum, 2).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 = "H column must be 0 or 1"
-            ws.Cells(rowNum, 8).Interior.Color = RGB(255, 0, 0)
+            ws.Cells(rowNum, 2).Value = "G column must be 0 or 1"
+            ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0)
            Exit Sub
        End If
    End If
@@ -166,5 +150,5 @@ Sub Z2_ToggleAutoFilter()
 End Sub

 Sub Z2_AutoFitColumnWidth()
-    Call AutoFitColumnWidth(2, 9)
+    Call AutoFitColumnWidth(2, 7)
 End Sub
--- a/src/thisWorkbook/Master_224.bas
+++ b/src/thisWorkbook/Master_224.bas
@@ -4,7 +4,7 @@ Sub Z3_ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long)
 End Sub

 Sub Z3_Import()
-    Call Generic_Master_Import(Me)
+    Call Generic_Master_Import(Me, 6)
 End Sub

 Sub Z3_Export()
@@ -29,7 +29,7 @@ Sub Z3_Export()
        Exit Sub
    End If

-    Call Generic_Master_Export(Me, 7, lastDataRow)
+    Call Generic_Master_Export(Me, 6, lastDataRow)
 End Sub

 Sub Validate(ByVal rowNum As Long)
@@ -40,7 +40,7 @@ Sub Validate(ByVal rowNum As Long)

    ' clear C~I columns background color
    Dim clearRange As Range
-    Set clearRange = ws.Range(ws.Cells(rowNum, 3), ws.Cells(rowNum, 9))
+    Set clearRange = ws.Range(ws.Cells(rowNum, 3), ws.Cells(rowNum, 8))
    clearRange.Interior.Color = vbWhite
    
    If cValue = "" Then
@@ -100,36 +100,28 @@ Sub Validate(ByVal rowNum As Long)
        Exit Sub
    End If
    
-    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, 7).Interior.Color = RGB(255, 0, 0)
-        Exit Sub
-    End If
-    
-    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, 9).Interior.Color = RGB(255, 0, 0)
-        Exit Sub
-    End If
-    
    Dim hValue As String
-    hValue = Trim(ws.Cells(rowNum, 8).Value)
+    hValue = Trim(ws.Cells(rowNum, 7).Value)
    If hValue <> "" Then
        If Len(hValue) <> 1 Then
-            ws.Cells(rowNum, 2).Value = "H column must be 1 digit"
-            ws.Cells(rowNum, 8).Interior.Color = RGB(255, 0, 0)
+            ws.Cells(rowNum, 2).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 = "H column must be 0 or 1"
-            ws.Cells(rowNum, 8).Interior.Color = RGB(255, 0, 0)
+            ws.Cells(rowNum, 2).Value = "G column must be 0 or 1"
+            ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0)
            Exit Sub
        End If
    End If
+
+    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, 8).Interior.Color = RGB(255, 0, 0)
+        Exit Sub
+    End If
    
    ws.Cells(rowNum, 2).ClearContents
 End Sub
@@ -166,5 +158,5 @@ Sub Z3_ToggleAutoFilter()
 End Sub

 Sub Z3_AutoFitColumnWidth()
-    Call AutoFitColumnWidth(2, 9)
+    Call AutoFitColumnWidth(2, 8)
 End Sub
--- a/src/thisWorkbook/Master_507.bas
+++ b/src/thisWorkbook/Master_507.bas
@@ -1,41 +1,6 @@
+' ====== (507) =======
 Sub O2_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 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
+    Call Generic_Master_Import(Me, 13)
 End Sub

 Sub O2_SortDataRowsByC()
@@ -47,5 +12,5 @@ Sub O2_ToggleAutoFilter()
 End Sub

 Sub O2_AutoFitColumnWidth()
-    Call AutoFitColumnWidth(3, 5)
+    Call AutoFitColumnWidth(3, 15)
 End Sub
--- a/通勤手当テンプレート_案.xlsm
+++ b/通勤手当テンプレート_案.xlsm