vba/src/sh/tuk/sheet/M1.cls

' ============================================================
' Module Name: Master_Kukan
' Module Desc: M1 Kukan master data management (import/export/validate)
' Module Methods:
'   - CreateEnumDropdown
'   - Worksheet_Change
'   - Validate
' ============================================================

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim HasHeaderEdit As Boolean: HasHeaderEdit = CheckHeaderEdit(Me, Target)
    If HasHeaderEdit = True Then Exit Sub
    
    Application.EnableEvents = False
    On Error GoTo Finally
    
    ' Multi-cell selection not processed
    If Target.Count > 1 Then GoTo Finally
    
    ' === Column C changes: Create L column dropdown ===
    If Target.Column = 3 And Target.Row >= 7 Then
        Dim cell As Range
        For Each cell In Target
            If Trim(cell.Value) = "" Then
                Call ClearDataRow(Me, cell.Row)
            Else
                Call BuildTokubetuDropdown(Me, "L", cell.Row)
                Call BuildRenrakuDropdown(Me, "K", cell.Row)
            End If
        Next
    End If

    ' === Column D changes: Fill E column ===
    If Target.Column = 4 And Target.Row >= 7 Then
        Dim z1Cache As Object: Set z1Cache = GetCache(CACHE_Z1)
        Dim z4Rosen As Object: Set z4Rosen = GetCache(CACHE_Z4ROSEN)
        Dim cellD As Range
        For Each cellD In Target
            Dim dVal As String: dVal = Trim(cellD.Value)
            If dVal = "" Then
                Me.Cells(cellD.Row, 5).ClearContents
                Me.Cells(cellD.Row, 6).ClearContents
                Me.Cells(cellD.Row, 7).ClearContents
                Me.Cells(cellD.Row, 6).Validation.Delete
                Me.Cells(cellD.Row, 7).Validation.Delete
            Else
                If z1Cache.Exists(dVal) Then
                    Dim kikan As Variant: kikan = z1Cache(dVal)
                    Dim kikanName As String: kikanName = kikan(0)
                    Me.Cells(cellD.Row, 5).Value = kikanName

                    If z4Rosen.Exists(kikanName) Then
                        Call BuildZ4StationFromDropdown(Me, "F", cellD.Row, kikanName)
                        Dim stations As Object: Set stations = z4Rosen(kikanName)
                        Dim fromCell As Range: Set fromCell = Me.Cells(cellD.Row, 6)
                        Dim fromStation As String: fromStation = Trim(fromCell.Value)
                        If Not stations.Exists(fromStation) Or fromStation = "" Then
                            fromCell.ClearContents
                            Me.Cells(cellD.Row, 7).ClearContents
                            Me.Cells(cellD.Row, 7).Validation.Delete
                        Else
                            Call BuildZ4StationToDropdown(Me, "G", cellD.Row, kikanName, fromStation)
                            Dim toCell As Range: Set toCell = Me.Cells(cellD.Row, 7)
                            Dim toStation As String: toStation = Trim(toCell.Value)

                            If Not stations.Exists(toStation) Or toStation = "" Then
                                toCell.ClearContents
                            End If
                        End If
                    Else
                        Me.Cells(cellD.Row, 6).ClearContents
                        Me.Cells(cellD.Row, 7).ClearContents
                        Me.Cells(cellD.Row, 6).Validation.Delete
                        Me.Cells(cellD.Row, 7).Validation.Delete
                    End If
                    
                Else
                    Me.Cells(cellD.Row, 5).ClearContents
                    Me.Cells(cellD.Row, 6).ClearContents
                    Me.Cells(cellD.Row, 7).ClearContents
                    Me.Cells(cellD.Row, 6).Validation.Delete
                    Me.Cells(cellD.Row, 7).Validation.Delete
                End If
            End If
            
        Next
    End If

    ' === Column E changes (rosen name): Build F column (station from) dropdown ===
    ' If Target.Column = 4 And Target.Row >= 7 Then
    '     Dim cellE As Range
    '     For Each cellE In Target
    '         Dim rosenVal As String: rosenVal = Trim(cellE.Value)
    '         If rosenVal = "" Then
    '             Me.Cells(cellE.Row, 6).ClearContents
    '             Me.Cells(cellE.Row, 8).ClearContents
    '             Me.Cells(cellE.Row, 6).Validation.Delete
    '             Me.Cells(cellE.Row, 8).Validation.Delete
    '         Else
    '             Call BuildZ4StationFromDropdown(Me, "F", cellE.Row, rosenVal)
    '         End If
    '     Next
    ' End If

    ' === Column F changes (station from): Build H column (station to) dropdown ===
    If Target.Column = 6 And Target.Row >= 7 Then
        Dim cellF As Range
        For Each cellF In Target
            Dim stationFrom As String: stationFrom = Trim(cellF.Value)
            Dim rosenForH As String: rosenForH = Trim(Me.Cells(cellF.Row, 5).Value)
            If stationFrom = "" Then
                Me.Cells(cellF.Row, 7).ClearContents
                Me.Cells(cellF.Row, 7).Validation.Delete
            Else
                Call BuildZ4StationToDropdown(Me, "G", cellF.Row, rosenForH, stationFrom)
            End If
        Next
    End If

    Application.EnableEvents = True
    Exit Sub

Finally:
    HandleError "Worksheet_Change"
    Application.EnableEvents = True
End Sub

' Prevent insert/delete row in header area
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
    Dim sheetConf As Object: Set sheetConf = sheetConfDict(Me.CodeName)
    Dim filterRow As Long: filterRow = sheetConf("FilterRow")

    If Target.Row < filterRow + 1 Then
        Cancel = True
        MsgBox "Cannot insert or delete row in header area.", vbExclamation
    End If
End Sub

Private 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 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
            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
    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
            errorCell.Value = GetErrorMsg("E011", colLetter & rowNum)
            ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0)
            Exit Sub
        End If
    Next colLetter

    ' Check C column repeat
    Dim cValue As String: cValue = Trim(ws.Range("C" & rowNum).Value)
    Dim foundCell As Range
    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
            errorCell.Value = "C column value is duplicated"
            ws.Range("C" & rowNum).Interior.Color = RGB(255, 0, 0)
            Exit Sub
        End If
    End If

    ' Check D and E column in the cache
    Dim z1Cache As Object: Set z1Cache = GetCache(CACHE_Z1)

    Dim dValue As String: dValue = Trim(ws.Range("D" & rowNum).Value)
    Dim eValue As String: eValue = Trim(ws.Range("E" & rowNum).Value)

    If Not z1Cache.Exists(dValue) Then
        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
            errorCell.Value = "Invalid reference data for D column."
            Exit Sub
        End If

        Dim expectedEValue As String
        expectedEValue = Trim(CStr(valueArray(0)))

        If eValue <> expectedEValue Then
            errorCell.Value = "E column does not match reference data."
            ws.Range("E" & rowNum).Interior.Color = RGB(255, 0, 0)
            Exit Sub
        End If
    End If

    ' Check L column in the tokubetuList
    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
        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
    If Not StartsWith(errorCell.Value, "W") Then
        errorCell.ClearContents
    End If
    Exit Sub

ErrHandler:
    lastErrorMsg = Err.Description
End Sub

' obtain z1 master data, and update column E
Private Sub Refresh(ws As Worksheet, ByVal startRow As Long, ByVal lastDataRow As Long)
    Dim z1Cache As Object: Set z1Cache = GetCache(CACHE_Z1)
    
    Application.EnableEvents = False
    On Error GoTo ErrorHandler
    
    Dim r As Long
    For r = startRow To lastDataRow
        Dim dVal As String: dVal = Trim(ws.Cells(r, 4).Value) ' Column D
        If dVal <> "" And z1Cache.Exists(dVal) Then
            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
    Exit Sub

ErrorHandler:
    Application.EnableEvents = True
    Err.Raise ERR_CACHE_NOT_FOUND, "M1.Refresh", "Failed to refresh M1: " & Err.Description
End Sub

Private Sub ValidateWarn(ws As Worksheet, ByVal lastDataRow As Long)
    On Error GoTo ErrorHandler
    Dim exitMsg As String

    ' Get M2 sheet kukan code list directly
    Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
    Dim m2SheetConf As Object: Set m2SheetConf = sheetConfDict(CACHE_M2)
    Dim m2StartRow As Long: m2StartRow = m2SheetConf("StartRow")
    Dim wsM2 As Worksheet: Set wsM2 = ThisWorkbook.Worksheets(CACHE_M2)
    Dim lastRowM2 As Long: lastRowM2 = GetLastDataRowInRange(wsM2)
    If lastRowM2 < m2StartRow Then
        exitMsg = "M2 sheet has no data"
        GoTo ErrorHandler
    End If
    
    ' Build kukan code list from M2 sheet
    Dim kukanList As Object: Set kukanList = CreateObject("Scripting.Dictionary")
    Dim r As Long
    For r = m2StartRow To lastRowM2
        Dim kukanCode As String: kukanCode = Trim(wsM2.Cells(r, 3).Value)
        If kukanCode <> "" And Not kukanList.Exists(kukanCode) Then
            kukanList.Add kukanCode, True
        End If
    Next r

    
    Dim sheetConf As Object: Set sheetConf = sheetConfDict("M1")
    Dim startRow As Long: startRow = sheetConf("StartRow")
    Dim errorCol As String: errorCol = sheetConf("ErrorCol")
    ' Check all rows in M1 sheet
    If lastDataRow < startRow Then
        exitMsg = "M1 sheet has no data"
        GoTo ErrorHandler
    End If
    
    Dim rowNum As Long
    For rowNum = startRow To lastDataRow
        Dim cValue As String: cValue = Trim(ws.Range("C" & rowNum).Value)        
        If Not kukanList.Exists(cValue) Then
            ws.Cells(rowNum, errorCol).Value = GetErrorMsg("W001", cValue)
            ws.Range("C" & rowNum).Interior.Color = RGB(255, 128, 0)
        End If
NextRow:
    Next rowNum
    
    Exit Sub

ErrorHandler:
    If exitMsg <> "" Then
        MsgBox "ValidateWarn: " & exitMsg, vbExclamation
    Else
        MsgBox "ValidateWarn: " & Err.Description, vbExclamation
    End If
End Sub