20260515指摘対応8

2026-05-21 16:02:08 +09:00
parent bee1cd9810
commit 0a633d711c
6 changed files with 315 additions and 252 deletions
--- a/src/sh/tuk/module/Common_Button.bas
+++ b/src/sh/tuk/module/Common_Button.bas
@@ -137,9 +137,9 @@ Private Sub DO_CSV_Import(ws As Excel.Worksheet)
    End If

    ' === Step 4: Clear all data rows before import ===
+    Call ClearDataRows(ws)
    Application.ScreenUpdating = False
    Application.EnableEvents = False
-    Call ClearDataRows(ws)

    ' === Step 5: Write CSV data to worksheet ===
    Dim colLetters As Variant: colLetters = cfg("HeaderColumns")
@@ -194,11 +194,16 @@ Private Sub Do_Validation(ws As Excel.Worksheet)
        Application.Run "M1.ValidateWarn", ws, lastDataRow
    End If

-    Do_Fit ws
+    GoTo FinallyExit
    Exit Sub

 ErrorHandler:
    HandleError "Do_Validation"
+    GoTo FinallyExit
+
+FinallyExit:
+    Do_Fit ws
+    ClearFormatsBelowLastDataRow ws
 End Sub

 ' ============================================================
@@ -258,9 +263,11 @@ Private Sub DO_CSV_Export(ws As Excel.Worksheet)
    
    Dim colLetters As Variant: colLetters = sheetConf("HeaderColumns")
    Dim r As Long
+    Dim colIndex 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)
+            colIndex = Columns(colLetters(colIdx)).Column
+            outputArr(dataRow, colIdx + 1) = CleanCSVField(ws.Cells(r, colIndex).Value)
        Next colIdx
        dataRow = dataRow + 1
    Next r
--- a/src/sh/tuk/module/Common_Functions.bas
+++ b/src/sh/tuk/module/Common_Functions.bas
@@ -45,7 +45,7 @@ ErrorHandler:
    Err.Raise ERR_CONFIG_INVALID, "GetCSVHeader", "Invalid column letter in HeaderColumns: '" & colLetters(i) & "'"
 End Function

-'
+' Clean CSV field: add quote prefix for formula-like values
 Function CleanCSVField(ByVal inputStr As String) As String
    Dim s As String
    s = Trim(inputStr)
@@ -62,10 +62,12 @@ Function CleanCSVField(ByVal inputStr As String) As String
    CleanCSVField = s
 End Function

+' Get last data row in specified column
 Function GetLastDataRow(ByVal ws As Worksheet, ByVal columnNum As Long) As Long
    GetLastDataRow = ws.Cells(ws.Rows.Count, columnNum).End(xlUp).Row
 End Function

+' Check if array contains value
 Function Contains(ByVal arr As Variant, ByVal value As String) As Boolean
    Dim i As Long
    For i = 0 To UBound(arr)
@@ -184,7 +186,7 @@ ErrHandler:
    Err.Raise Err.Number, Err.Source, Err.Description
 End Function

-' obtain
+' Get last data row in specified column
 Function GetLastDataRowInRange(ws As Worksheet) As Long

    Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
@@ -218,6 +220,7 @@ InvalidColumn:
    Err.Raise ERR_CONFIG_INVALID, "GetLastDataRowInRange", "Invalid column letter for sheet: " & ws.CodeName
 End Function

+'Clear single row data and format
 Function ClearDataRow(ByVal ws As Worksheet, ByVal startCol As Long, ByVal endCol As Long, ByVal rowRow As Long, Optional ByVal errorCol As Long = 2)
    If rowRow >= 7 Then
        Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowRow, startCol), ws.Cells(rowRow, endCol))
@@ -227,8 +230,9 @@ Function ClearDataRow(ByVal ws As Worksheet, ByVal startCol As Long, ByVal endCo
    End If
 End Function

+'Clear all data rows from startRow to lastDataRow
 Sub ClearDataRows(ByVal ws As Worksheet)
-    ' 
+    ' Clear data and format from startRow to lastDataRow
    Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
    ' 
    If Not sheetConfDict.Exists(ws.CodeName) Then
@@ -241,10 +245,9 @@ Sub ClearDataRows(ByVal ws As Worksheet)
    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)

-    '
+    Application.EnableEvents = False
+    Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(ws)
    If lastDataRow >= startRow Then
        Dim clearRange As Range
        Set clearRange = ws.Range(ws.Cells(startRow, ws.Range(startCol & "1").Column), ws.Cells(lastDataRow, ws.Range(endCol & "1").Column))
@@ -258,9 +261,52 @@ Sub ClearDataRows(ByVal ws As Worksheet)
          clearErrorRange.Interior.Color = vbWhite
        End If
    End If
+    
+    ' Clear formats below lastDataRow (including dropdowns)
+    Application.EnableEvents = True
+    Call ClearFormatsBelowLastDataRow(ws)
 End Sub

-' Format: code:value (no space around colon)
+'Clear formats below lastDataRow
+Sub ClearFormatsBelowLastDataRow(ws As Worksheet)
+    On Error GoTo ErrorHandler
+    Dim lastRow As Long: lastRow = GetLastDataRowInRange(ws)
+    
+    Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
+    Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
+    
+    Dim startCol As Long, endCol As Long
+    startCol = ws.Range(sheetConf("ErrorCol") & "1").Column
+    endCol = ws.Range(sheetConf("EndCol") & "1").Column
+
+    If lastRow >= ws.Rows.Count Then Exit Sub
+
+    Dim clearRange As Range
+    Set clearRange = ws.Range( _
+        ws.Cells(lastRow + 1, startCol), _
+        ws.Cells(ws.Rows.Count, endCol) _
+    )
+
+    Application.EnableEvents = False
+    clearRange.ClearContents
+    clearRange.Interior.Color = vbWhite
+    clearRange.Validation.Delete
+    Application.EnableEvents = True
+
+ErrorHandler:
+    Application.EnableEvents = True
+End Sub
+
+' Check if text starts with prefix
+Function StartsWith(text As String, prefix As String) As Boolean
+    If Len(text) < Len(prefix) Then
+        StartsWith = False
+    Else
+        StartsWith = (Left(text, Len(prefix)) = prefix)
+    End If
+End Function
+
+' Make select format: code:value
 Function MakeSelect(ByVal code As String, ByVal value As String) As String
    MakeSelect = Trim(code) & ":" & Trim(value)
 End Function
@@ -316,16 +362,16 @@ Public Function FormatDateInput(ByVal inputStr As String) As String
    End If
 End Function

+'Check header edit protection
 Function CheckHeaderEdit(ByVal ws As Worksheet, ByVal Target As Range) As Boolean
    Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
    Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
-    Dim headerRow As Long: headerRow = sheetConf("HeaderRow")
    Dim filterRow As Long: filterRow = sheetConf("FilterRow")

    ' Check header row (headerRow) cannot be edited
    Dim r As Long
    For r = Target.Row To Target.Row + Target.Rows.Count - 1
-        If r = headerRow Or r = filterRow Then
+        If r = 1 Or r = filterRow Then
            Application.EnableEvents = False
            MsgBox "Header or type definition row cannot be edited.", vbExclamation
            Application.Undo
@@ -355,6 +401,7 @@ Function CheckHeaderEdit(ByVal ws As Worksheet, ByVal Target As Range) As Boolea
    CheckHeaderEdit = False
 End Function

+'Get error message by code
 Function GetErrorMsg(ByVal errorCode As String, Optional ByVal param0 As String = "", Optional ByVal param1 As String = "") As String
    Dim errorList As Object: Set errorList = GetCache("errorList")
    Dim errorMessage As String
@@ -366,10 +413,12 @@ Function GetErrorMsg(ByVal errorCode As String, Optional ByVal param0 As String
    GetErrorMsg = errorMessage
 End Function

+'Convert column number to letter
 Function ColLetter(colNum As Long) As String
    ColLetter = Split(Cells(1, colNum).Address, "$")(1)
 End Function

+'Check required field is not empty
 Function CheckRequired(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal errorCol As String) As Boolean
    Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
    If checkValue = "" Then
@@ -382,6 +431,7 @@ Function CheckRequired(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum
    CheckRequired = True
 End Function

+'Check character length
 Function CheckChar(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal charLength As Long, ByVal errorCol As String)
    Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
    If Len(checkValue) <> charLength Then
@@ -394,6 +444,7 @@ Function CheckChar(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As
    CheckChar = True
 End Function

+'Check alphanumeric characters
 Function CheckAlphanumeric(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal charLength As Long, ByVal errorCol As String)
    Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
    Dim letter As String: letter = ColLetter(colNum)
@@ -412,6 +463,7 @@ Function CheckAlphanumeric(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal co
    CheckAlphanumeric = True
 End Function

+'Check varchar length overflow
 Function CheckVarcharOver(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal varcharLength As Long, ByVal errorCol As String)
    Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
    If Len(checkValue) > varcharLength Then
@@ -424,6 +476,7 @@ Function CheckVarcharOver(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal col
    CheckVarcharOver = True
 End Function

+'Check number length overflow
 Function CheckNumberOver(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal numberLength As Long, ByVal errorCol As String)
    Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
    If Len(checkValue) > numberLength Then
@@ -436,6 +489,7 @@ Function CheckNumberOver(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colN
    CheckNumberOver = True
 End Function

+'Check value is 0 or 1
 Function Check01(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal errorCol As String)
    Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
    Dim letter As String: letter = ColLetter(colNum)
@@ -456,6 +510,7 @@ Function Check01(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Lo
    Check01 = True
 End Function

+'Check value is 1 or 2
 Function Check12(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal errorCol As String)
    Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
    Dim letter As String: letter = ColLetter(colNum)
@@ -476,6 +531,7 @@ Function Check12(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Lo
    Check12 = True
 End Function

+'Check duplicate value in column
 Function CheckDuplicate(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal errorCol As String) As Boolean
    Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
    Dim letter As String: letter = ColLetter(colNum)
@@ -493,6 +549,7 @@ Function CheckDuplicate(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNu
    CheckDuplicate = True
 End Function

+'Check numeric value
 Function CheckNumber(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal errorCol As String) As Boolean
    Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
    Dim letter As String: letter = ColLetter(colNum)
--- a/src/sh/tuk/module/Common_Global_Cache.bas
+++ b/src/sh/tuk/module/Common_Global_Cache.bas
@@ -419,7 +419,7 @@ Private Sub RefreshSheetDict()
    sheetConf("AlwaysQuote") = True
    sheetConf("FilterRow") = 6
    sheetConf("KeyCol") = 3
-    sheetConf("ValueCols") = Array(4, 6, 8, 9, 10, 11, 12, 13)
+    sheetConf("ValueCols") = Array(4, 8, 9, 10, 11, 12, 13)
    Set sheetConfDict("T2") = sheetConf
    Debug.Print "RefreshSheetDict T2 ok."

--- a/src/sh/tuk/sheet/M1.cls
+++ b/src/sh/tuk/sheet/M1.cls
@@ -59,11 +59,13 @@ Private Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
    Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
    clearRange.Interior.Color = vbWhite

+    Dim errorCell As Range: Set errorCell = ws.Cells(rowNum, errorCol)
+
    ' 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, errorCol).Value = GetErrorMsg("E002", colLetter & rowNum)
+            errorCell.Value = GetErrorMsg("E002", colLetter & rowNum)
            ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0)
            Exit Sub
        End If
@@ -73,7 +75,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, errorCol).Value = GetErrorMsg("E011", colLetter & rowNum)
+            errorCell.Value = GetErrorMsg("E011", colLetter & rowNum)
            ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0)
            Exit Sub
        End If
@@ -85,7 +87,7 @@ 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, errorCol).Value = "C column value is duplicated"
+            errorCell.Value = "C column value is duplicated"
            ws.Range("C" & rowNum).Interior.Color = RGB(255, 0, 0)
            Exit Sub
        End If
@@ -98,14 +100,14 @@ Private Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
    Dim eValue As String: eValue = Trim(ws.Range("E" & rowNum).Value)

    If Not z1Cache.Exists(dValue) Then
-        ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E004", "D" & rowNum)
+        errorCell.Value = GetErrorMsg("E004", "D" & rowNum)
        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, errorCol).Value = "Invalid reference data for D column."
+            errorCell.Value = "Invalid reference data for D column."
            Exit Sub
        End If

@@ -113,7 +115,7 @@ 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, errorCol).Value = "E column does not match reference data."
+            errorCell.Value = "E column does not match reference data."
            ws.Range("E" & rowNum).Interior.Color = RGB(255, 0, 0)
            Exit Sub
        End If
@@ -123,13 +125,15 @@ Private Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
    Dim tokubetuList As Object: Set tokubetuList = GetCache("tokubetuList")
    Dim lValue As String: lValue = Trim(ws.Range("L" & rowNum).Value)
    If Not tokubetuList.Exists(lValue) Then
-        ws.Cells(rowNum, errorCol).Value = "L column does not exist."
+        errorCell.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, errorCol).ClearContents
+    If Not StartsWith(errorCell.Value, "W") Then
+        errorCell.ClearContents
+    End If
    Exit Sub

 ErrHandler:
@@ -150,6 +154,8 @@ Private Sub Refresh(ws As Worksheet, ByVal startRow As Long, ByVal lastDataRow A
            Dim valsD As Variant: valsD = z1Cache(dVal)
            ws.Cells(r, 5).Value = valsD(0) ' Column E
        End If
+        Call BuildTokubetuDropdown(ws, "L", r)
+        Call BuildRenrakuDropdown(ws, "K", r)
    Next r

    Application.EnableEvents = True
--- a/src/sh/tuk/sheet/M2.cls
+++ b/src/sh/tuk/sheet/M2.cls
@@ -53,9 +53,10 @@ Private Sub Worksheet_Change(ByVal Target As Range)
            End If
            ' clear
            Me.Range(Me.Cells(cellI.Row, 10), Me.Cells(cellI.Row, 18)).ClearContents
-            Me.Cells(cellI.Row, 11).Validation.Delete
            Me.Range(Me.Cells(cellI.Row, 10), Me.Cells(cellI.Row, 18)).Interior.Color = vbWhite
+            Me.Cells(cellI.Row, 10).Validation.Delete
            Call CreateJDropdown(cellI.Row)
+            Call ChangeBackColor(cellI.Row)
        Next
    End If
    
@@ -93,19 +94,201 @@ Finally:
    Application.EnableEvents = True ' 
 End Sub

+Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
+    On Error GoTo ErrHandler
+    
+    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
+
+    Dim errorCell As Range: Set errorCell = ws.Cells(rowNum, errorCol)
+
+    ' Check C column in the cache
+    Dim m1Cache As Object: Set m1Cache = GetCache("M1")
+
+    ' C column check
+    checkResult = CheckRequired(ws, rowNum, 3, errorCol)
+    If checkResult = False Then Exit Sub
+
+    Dim cValue As String: cValue = Trim(ws.Range("C" & rowNum).Value)
+    If Not m1Cache.Exists(cValue) Then        
+        errorCell.Value = GetErrorMsg("E004", "C" & rowNum)
+        ws.Range("C" & rowNum).Interior.Color = RGB(255, 0, 0)
+        Exit Sub
+    End If
+    
+    ' Check column required
+    Dim colLetter As Variant
+    For Each colLetter In Array("I", "J", "K", "L", "M")
+        If Trim(ws.Range(colLetter & rowNum).Value) = "" Then
+            errorCell.Value = GetErrorMsg("E002", colLetter & rowNum)
+            ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0)
+            Exit Sub
+        End If
+    Next colLetter
+
+    ' 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
+            errorCell.Value = GetErrorMsg("E011", col & rowNum)
+            ws.Range(col & rowNum).Interior.Color = RGB(255, 0, 0)
+            Exit Sub
+        End If
+    Next col
+
+    Dim kenshuKbn As String: kenshuKbn = Trim(ws.Range("I" & rowNum).Value)
+    
+    Dim cache As Object
+    Dim requiredCols As Variant
+    Dim equaledCols As Variant
+    Dim emptyCols As Variant
+    If kenshuKbn = "1" Then
+        Set cache = GetCache("T1")
+        ' must input
+        equaledCols = Array("K")
+        requiredCols = Array("N")
+        emptyCols = Array("O", "P", "Q", "R")
+    End If
+
+    If kenshuKbn = "2" Then
+        Set cache = GetCache("T2")
+        ' must input
+        equaledCols = Array("K", "L", "M", "N", "O", "P", "Q")
+        requiredCols = Array("N", "O", "P", "Q")
+        emptyCols = Array("R")
+    End If
+
+    If kenshuKbn = "3" Then
+        Set cache = GetCache("T3")
+        ' must input
+        equaledCols = Array("K", "L", "M")
+        requiredCols = Array()
+        emptyCols = Array("N", "O", "P", "Q", "R")
+    End If
+
+    ' Check J column in the T1, T2, T3
+    ' code not exist check
+    Dim code As String: code = Trim(ws.Range("J" & rowNum).Value)
+    If Not cache.Exists(code) Then
+        errorCell.Value = GetErrorMsg("E004", "J" & rowNum)
+        ws.Range("J" & rowNum).Interior.Color = RGB(255, 0, 0)
+        Exit Sub
+    End If
+
+    Dim equaledCol As Variant
+    Dim equaledIndex As Long
+    For equaledIndex = LBound(equaledCols) To UBound(equaledCols)
+        equaledCol = equaledCols(equaledIndex)
+        ' M2 value
+        Dim equalValue As String: equalValue = Trim(ws.Range(equaledCol & rowNum).Value)
+        If cache(code)(equaledIndex) <> equalValue Then
+            errorCell.Value = GetErrorMsg("E004", equaledCol & rowNum)
+            ws.Range(equaledCol & rowNum).Interior.Color = RGB(255, 0, 0)
+            Exit Sub
+        End If
+    Next equaledIndex
+
+    Dim requiredCol As Variant
+    For Each requiredCol In requiredCols
+        Dim requiredValue As String: requiredValue = Trim(ws.Range(requiredCol & rowNum).Value)
+        If requiredValue = "" Then
+          errorCell.Value = GetErrorMsg("E002", requiredCol & rowNum)
+          ws.Range(requiredCol & rowNum).Interior.Color = RGB(255, 0, 0)
+          Exit Sub
+        End If
+    Next requiredCol
+
+    Dim emptyCol As Variant
+    For Each emptyCol In emptyCols
+        Dim emptyValue As String: emptyValue = Trim(ws.Range(emptyCol & rowNum).Value)
+        If emptyValue <> "" Then
+          errorCell.Value = GetErrorMsg("E005", emptyCol & rowNum)
+          ws.Range(emptyCol & rowNum).Interior.Color = RGB(255, 0, 0)
+          Exit Sub
+        End If
+    Next emptyCol
+
+    ' check Duplicate
+    Dim i As Long
+    For i = 7 To rowNum - 1
+        If Trim(ws.Cells(i, "C").Value) = cValue And Trim(ws.Cells(i, "I").Value) = kenshuKbn And Trim(ws.Cells(i, "J").Value) = code Then
+            errorCell.Value = GetErrorMsg("E013", i, code)
+            ws.Cells(rowNum, "C").Interior.Color = RGB(255, 0, 0)
+            Exit Sub
+        End If
+    Next i
+    
+    errorCell.ClearContents
+    Application.EnableEvents = False
+    Call ChangeBackColor(rowNum)
+    Application.EnableEvents = True
+    Exit Sub
+
+ErrHandler:
+    lastErrorMsg = Err.Description
+End Sub
+
+' obtain T1/T2/T3 cache data, and update column K
+Private Sub Refresh(ws As Worksheet, ByVal startRow As Long, ByVal lastDataRow As Long)
+    Dim kenshuList As Object: Set kenshuList = GetCache("kenshuList")
+    
+    Application.EnableEvents = False
+    On Error GoTo ErrorHandler
+    
+    Dim r As Long
+    For r = startRow To lastDataRow
+        Dim cValue As String: cValue = Trim(ws.Cells(r, 3).Value) ' Column C
+        
+        ' Skip if C column is empty
+        If cValue = "" Then
+            GoTo NextRow
+        End If
+        
+        ' Reuse FillFromM1 method to fill D-H columns
+        Call FillFromM1(ws, r)
+        Call BuildKenshuDropdown(ws, "I", r)
+        
+        ' Reuse FillKFromJ method to fill J-K columns
+        Dim iValue As String: iValue = Trim(ws.Cells(r, 9).Value) ' Column I
+        If iValue <> "" And kenshuList.Exists(iValue) Then
+            Call CreateJDropdown(r)
+            Call ChangeBackColor(r)
+            Call FillKFromJ(ws, r)
+        End If
+        
+NextRow:
+    Next r
+    
+    Application.EnableEvents = True
+    Exit Sub
+
+ErrorHandler:
+    Application.EnableEvents = True
+    Err.Raise ERR_CACHE_NOT_FOUND, "M2.Refresh", "Failed to refresh M2: " & Err.Description
+End Sub
+
 Private Sub FillKFromJ(ByVal ws As Worksheet, ByVal rowNum As Long)
-    Dim iValue As String: iValue = Trim(ws.Range("I" & rowNum).Value)
+    Dim kenshu As String: kenshu = Trim(ws.Range("I" & rowNum).Value)
    Dim jValue As String: jValue = Trim(ws.Range("J" & rowNum).Value)
    Dim code As String: code = GetCode(jValue)
    
    If jValue = "" Then
-        ws.Range("K" & rowNum).ClearContents
+        ws.Range(ws.Cells(rowNum, "K"), ws.Cells(rowNum, "R")).ClearContents
        Exit Sub
    End If
    
    ' Get cache based on I column value
    Dim cache As Object
-    Select Case iValue
+    Select Case kenshu
        Case "1"
            Set cache = GetCache("T1")
        Case "2"
@@ -119,7 +302,6 @@ Private Sub FillKFromJ(ByVal ws As Worksheet, ByVal rowNum As Long)
    If cache Is Nothing Then Exit Sub
    
    ' Check if J value exists in cache
-    
    If cache.Exists(code) Then
        Dim cacheVal As Variant: cacheVal = cache(code)
        ws.Range("J" & rowNum).Value = Trim(code)
@@ -130,12 +312,12 @@ Private Sub FillKFromJ(ByVal ws As Worksheet, ByVal rowNum As Long)
        Case "1"
            Exit Sub
        Case "2"
-            ws.Range("L" & rowNum).Value = Trim(cacheVal(2))
-            ws.Range("M" & rowNum).Value = Trim(cacheVal(3))
-            ws.Range("N" & rowNum).Value = Trim(cacheVal(4))
-            ws.Range("O" & rowNum).Value = Trim(cacheVal(5))
-            ws.Range("P" & rowNum).Value = Trim(cacheVal(6))
-            ws.Range("Q" & rowNum).Value = Trim(cacheVal(7))
+            ws.Range("L" & rowNum).Value = Trim(cacheVal(1))
+            ws.Range("M" & rowNum).Value = Trim(cacheVal(2))
+            ws.Range("N" & rowNum).Value = Trim(cacheVal(3))
+            ws.Range("O" & rowNum).Value = Trim(cacheVal(4))
+            ws.Range("P" & rowNum).Value = Trim(cacheVal(5))
+            ws.Range("Q" & rowNum).Value = Trim(cacheVal(6))
        Case "3"
            ws.Range("L" & rowNum).Value = Trim(cacheVal(1))
            ws.Range("M" & rowNum).Value = Trim(cacheVal(2))
@@ -145,39 +327,6 @@ Private Sub FillKFromJ(ByVal ws As Worksheet, ByVal rowNum As Long)
    
 End Sub

-Private Sub CreateJDropdown(ByVal rowNum As Long)
-    Dim iValue As String: iValue = Trim(Me.Range("I" & rowNum).Value)
-    Dim targetCell As Range: Set targetCell = Me.Range("J" & rowNum)
-    
-    ' Clear existing validation
-    targetCell.Validation.Delete
-    targetCell.ClearContents
-    
-    ' Get cache based on I column value
-    Dim cache As Object
-    Select Case iValue
-        Case "1"
-            Set cache = GetCache("T1")
-            Me.Range("O" & rowNum).Interior.Color = RGB(192, 192, 192)
-            Me.Range("P" & rowNum).Interior.Color = RGB(192, 192, 192)
-            Me.Range("Q" & rowNum).Interior.Color = RGB(192, 192, 192)
-        Case "2"
-            Set cache = GetCache("T2")
-        Case "3"
-            Set cache = GetCache("T3")
-            Me.Range("N" & rowNum).Interior.Color = RGB(192, 192, 192)
-            Me.Range("O" & rowNum).Interior.Color = RGB(192, 192, 192)
-            Me.Range("P" & rowNum).Interior.Color = RGB(192, 192, 192)
-            Me.Range("Q" & rowNum).Interior.Color = RGB(192, 192, 192)
-        Case Else
-            Exit Sub
-    End Select
-    
-    If cache Is Nothing Then Exit Sub
-    
-    Call BuildDropdownFromCacheNamedRange(Me, "J", rowNum, "T" & iValue)
-End Sub
-
 Private Sub FillFromM1(ByVal ws As Worksheet, ByVal rowNum As Long)
    Dim m1Cache As Object: Set m1Cache = GetCache("M1")
    Dim cValue As String: cValue = Trim(ws.Range("C" & rowNum).Value)
@@ -221,197 +370,41 @@ Private Sub ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long)
    ws.Cells(rowNum, "S").ClearContents
 End Sub

-Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
-    On Error GoTo ErrHandler
+Private Sub CreateJDropdown(ByVal rowNum As Long)
+    Dim kenshu As String: kenshu = Trim(Me.Range("I" & rowNum).Value)
+    Dim targetCell As Range: Set targetCell = Me.Range("J" & rowNum)
    
-    Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
-    Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
+    ' Clear existing validation
+    targetCell.Validation.Delete
+    If kenshu = "" Then
+        Exit Sub
+    End If 
+    Call BuildDropdownFromCacheNamedRange(Me, "J", rowNum, "T" & kenshu)
+End Sub

-    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
-
-    ' Check C column in the cache
-    Dim m1Cache As Object: Set m1Cache = GetCache("M1")
-
-    ' C column check
-    checkResult = CheckRequired(ws, rowNum, 3, errorCol)
-    If checkResult = False Then Exit Sub
-
-    Dim cValue As String: cValue = Trim(ws.Range("C" & rowNum).Value)
-    If Not m1Cache.Exists(cValue) Then        
-        ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E004", "C" & rowNum)
-        ws.Range("C" & rowNum).Interior.Color = RGB(255, 0, 0)
+' change back color by I colum kennshu
+Private Sub ChangeBackColor(ByVal rowNum As Long)
+    Dim kenshu As String: kenshu = Trim(Me.Range("I" & rowNum).Value)
+    If kenshu = "" Then
        Exit Sub
    End If 

-    ' Check column required
-    Dim colLetter As Variant
-    For Each colLetter In Array("I", "J", "K", "L", "M")
-        If Trim(ws.Range(colLetter & rowNum).Value) = "" Then
-            ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E002", colLetter & rowNum)
-            ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0)
-            Exit Sub
-        End If
-    Next colLetter
-
-    ' 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, errorCol).Value = GetErrorMsg("E011", col & rowNum)
-            ws.Range(col & rowNum).Interior.Color = RGB(255, 0, 0)
-            Exit Sub
-        End If
-    Next col
-
-    ' Check J column in the T1, T2, T3
-    Dim code As String: code = Trim(ws.Range("J" & rowNum).Value)
-    Dim name As String: name = Trim(ws.Range("K" & rowNum).Value)
-    Dim valueL As String: valueL = Trim(ws.Range("L" & rowNum).Value)
-    Dim valueM As String: valueM = Trim(ws.Range("M" & rowNum).Value)
-    Dim valueN As String: valueN = Trim(ws.Range("N" & rowNum).Value)
-    Dim valueO As String: valueO = Trim(ws.Range("O" & rowNum).Value)
-    Dim valueP As String: valueP = Trim(ws.Range("P" & rowNum).Value)
-    Dim valueQ As String: valueQ = Trim(ws.Range("Q" & rowNum).Value)
+    Me.Range("R" & rowNum).Interior.Color = RGB(192, 192, 192)
+    ' Get cache based on I column value
    Dim cache As Object
-    Dim requiredCols As Variant
-    Dim equaledCols As Variant
-    Dim emptyCols As Variant
-    If kenshuKbn = "1" Then
-        Set cache = GetCache("T1")
-        ' must input
-        equaledCols = Array("K")
-        requiredCols = Array("N")
-        emptyCols = Array("O", "P", "Q", "R")
-    End If
-
-    If kenshuKbn = "2" Then
-        Set cache = GetCache("T2")
-        ' must input
-        equaledCols = Array("K", "L", "M", "N", "O", "P", "Q")
-        requiredCols = Array("N", "O", "P", "Q")
-        emptyCols = Array("R")
-    End If
-
-    If kenshuKbn = "3" Then
-        Set cache = GetCache("T3")
-        ' must input
-        equaledCols = Array("K", "L", "M")
-        requiredCols = Array()
-        emptyCols = Array("N", "O", "P", "Q", "R")
-    End If
-
-    ' code not exist check
-    If Not cache.Exists(code) Then
-        ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E004", "J" & rowNum)
-        ws.Range("J" & rowNum).Interior.Color = RGB(255, 0, 0)
+    Select Case kenshu
+        Case "1"
+            Me.Range("O" & rowNum).Interior.Color = RGB(192, 192, 192)
+            Me.Range("P" & rowNum).Interior.Color = RGB(192, 192, 192)
+            Me.Range("Q" & rowNum).Interior.Color = RGB(192, 192, 192)
+        Case "2"
            Exit Sub
-    End If
-
-    ' Dim equaledColIndex As Long
-    ' For equaledColIndex = 0 To 
-    
-    ' Dim equaledCol As Variant
-    ' For Each equaledCol In equaledCols
-    '     Dim equalValue As String: equalValue = Trim(ws.Range(equaledCol & rowNum).Value)
-    '     cache
-    '     If cache(code)(0) <> name Then
-    '       Exit Sub
-    '     End If
-    '   Me.Range(equaledCol & rowNum).Validation.Delete
-    ' Next equaledCol
-
-    Dim requiredCol As Variant
-    For Each requiredCol In requiredCols
-        Dim requiredValue As String: requiredValue = Trim(ws.Range(requiredCol & rowNum).Value)
-        If requiredValue = "" Then
-          ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E002", requiredCol & rowNum)
-          ws.Range(requiredCol & rowNum).Interior.Color = RGB(255, 0, 0)
+        Case "3"
+            Me.Range("N" & rowNum).Interior.Color = RGB(192, 192, 192)
+            Me.Range("O" & rowNum).Interior.Color = RGB(192, 192, 192)
+            Me.Range("P" & rowNum).Interior.Color = RGB(192, 192, 192)
+            Me.Range("Q" & rowNum).Interior.Color = RGB(192, 192, 192)
+        Case Else
            Exit Sub
-        End If
-    Next requiredCol
-
-    Dim emptyCol As Variant
-    For Each emptyCol In emptyCols
-        Dim emptyValue As String: emptyValue = Trim(ws.Range(emptyCol & rowNum).Value)
-        If emptyValue <> "" Then
-          ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E005", emptyCol & rowNum)
-          ws.Range(emptyCol & rowNum).Interior.Color = RGB(255, 0, 0)
-          Exit Sub
-        End If
-    Next emptyCol
-
-    ' check Duplicate
-    Dim i As Long
-    For i = 7 To rowNum - 1
-        If Trim(ws.Cells(i, "C").Value) = cValue And Trim(ws.Cells(i, "I").Value) = kenshuKbn And Trim(ws.Cells(i, "J").Value) = code Then
-            ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E013", i, checkValue)
-            ws.Cells(rowNum, "C").Interior.Color = RGB(255, 0, 0)
-            Exit Sub
-        End If
-        If Trim(ws.Cells(i, "C").Value) = cValue And Trim(ws.Cells(i, "I").Value) = kenshuKbn And Trim(ws.Cells(i, "K").Value) = name Then
-            ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E013", i, checkValue)
-            ws.Cells(rowNum, "C").Interior.Color = RGB(255, 0, 0)
-            Exit Sub
-        End If
-    Next i
-
-    ws.Cells(rowNum, errorCol).ClearContents
-    Exit Sub
-
-ErrHandler:
-    lastErrorMsg = Err.Description
-End Sub
-
-Public Sub ImportCSVAndTriggerChange(ws As Worksheet, ByVal lastDataRow As Long)
-    Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
-    Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
-
-    Dim startRow As Long: startRow = sheetConf("StartRow")
-    Dim i As Long
-    For i = startRow To lastDataRow
-        Call FillFromM1(ws, i)
-    Next i
-End Sub
-
-' obtain T1/T2/T3 cache data, and update column K
-Private Sub Refresh(ws As Worksheet, ByVal startRow As Long, ByVal lastDataRow As Long)
-    Dim kenshuList As Object: Set kenshuList = GetCache("kenshuList")
-    
-    Application.EnableEvents = False
-    On Error GoTo ErrorHandler
-    
-    Dim r As Long
-    For r = startRow To lastDataRow
-        Dim cValue As String: cValue = Trim(ws.Cells(r, 3).Value) ' Column C
-        
-        ' Skip if C column is empty
-        If cValue = "" Then
-            GoTo NextRow
-        End If
-        
-        ' Reuse FillFromM1 method to fill D-H columns
-        Call FillFromM1(ws, r)
-        
-        ' Reuse FillKFromJ method to fill J-K columns
-        Dim iValue As String: iValue = Trim(ws.Cells(r, 9).Value) ' Column I
-        If iValue <> "" And kenshuList.Exists(iValue) Then
-            Call FillKFromJ(ws, r)
-        End If
-        
-NextRow:
-    Next r
-    
-    Application.EnableEvents = True
-    Exit Sub
-
-ErrorHandler:
-    Application.EnableEvents = True
-    Err.Raise ERR_CACHE_NOT_FOUND, "M2.Refresh", "Failed to refresh M2: " & Err.Description
+    End Select
 End Sub
--- a/通勤手当テンプレート20260515.xlsm
+++ b/通勤手当テンプレート20260515.xlsm