Private Sub Worksheet_Change(ByVal Target As Range)
    ' === G列变化时生成F列下拉列表(匹配冒号左边) ===
    If Target.Column = 7 And Target.Row >= 7 Then
        If Target.Count > 1 Then Exit Sub
        Call MakeFDropdownByG(Me, Target.Row)
    End If
    
    ' === F列变化时提取冒号左边到G列 ===
    If Target.Column = 6 And Target.Row >= 7 Then
        If Target.Count > 1 Then Exit Sub
        If Trim(Target.Value) <> "" Then
            Dim fValue As String
            fValue = Trim(Target.Value)
            If InStr(fValue, ":") > 0 Then
                Target.Offset(0, 1).Value = Split(fValue, ":")(0)
                ' Don't trigger MakeFDropdownByG again - it's already set
            End If
        End If
    End If
    
    ' === C列变化时填充D、E ===
    If Target.Column = 3 And Target.Row >= 7 Then
        If Target.Count > 1 Then
            ' Handle multiple cells
            Dim cell As Range
            For Each cell In Target
                If cell.Column = 3 And cell.Row >= 7 Then
                    If Trim(cell.Value) = "" Then
                        Call ClearRowData(Me, cell.Row)
                    Else
                        Call FillFromKukanMaster(Me, cell.Row)
                    End If
                End If
            Next cell
            Exit Sub
        End If
        
        If Trim(Target.Value) = "" Then
            Call ClearRowData(Me, Target.Row)
        Else
            Call FillFromKukanMaster(Me, Target.Row)
        End If
    End If
End Sub



Sub MakeFDropdownByG(ByVal ws As Worksheet, ByVal rowNum As Long)
    Dim wsKotsu As Worksheet
    Dim lastRowKotsu As Long
    Dim k As Long
    Dim kotsuList As String
    Dim kotsuA As String
    Dim kotsuB As String
    Dim gValue As String
    Dim fVal As String
    Dim targetCellF As Range
    
    gValue = Trim(ws.Cells(rowNum, 7).Value)
    fVal = Trim(ws.Cells(rowNum, 6).Value)
    
    ' Skip if F already has matching value (prevent loop)
    If fVal <> "" And InStr(fVal, ":") > 0 Then
        If Split(fVal, ":")(0) = gValue Then
            Exit Sub
        End If
    End If
    
    On Error Resume Next
    Set wsKotsu = ThisWorkbook.Worksheets("交通機関マスタ")
    On Error GoTo 0
    
    If wsKotsu Is Nothing Then Exit Sub
    If gValue = "" Then Exit Sub
    
    lastRowKotsu = wsKotsu.Cells(wsKotsu.Rows.Count, "A").End(xlUp).Row
    
    kotsuList = ""
    For k = 4 To lastRowKotsu
        kotsuA = Trim(wsKotsu.Cells(k, 1).Value)
        kotsuB = Trim(wsKotsu.Cells(k, 2).Value)
        If kotsuA <> "" Then
            If kotsuList <> "" Then kotsuList = kotsuList & ","
            kotsuList = kotsuList & kotsuA & ":" & kotsuB
        End If
    Next k
    
    Set targetCellF = ws.Cells(rowNum, 6)
    On Error Resume Next
    targetCellF.ClearContents
    targetCellF.Validation.Delete
    On Error GoTo 0
    
    If kotsuList <> "" Then
        On Error Resume Next
        targetCellF.Validation.Add Type:=xlValidateList, Formula1:=kotsuList
        targetCellF.Validation.IgnoreBlank = True
        targetCellF.Validation.ShowDropDownWhenSelected = True
        ' Auto select the first matching one
        For k = 4 To lastRowKotsu
            If Trim(wsKotsu.Cells(k, 1).Value) = gValue Then
                targetCellF.Value = gValue & ":" & Trim(wsKotsu.Cells(k, 2).Value)
                Exit For
            End If
        Next k
    End If
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
    
    ' === 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, vbCrLf)
    
    If UBound(lines) < 1 Then
        MsgBox "CSVにデータがありません。", vbExclamation
        Exit Sub
    End If
    
    ' === Step 3: Collect CSV codes and data (include all columns including コード and 券種) ===
    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 "有効なコードが見つかりません。", 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列
        code = CleanCSVField(CStr(dataArray(0)))
        wsTarget.Cells(writeRow, 3).Value = code
        
        ' CSV col 2-11 -> G-P列
        If UBound(dataArray) >= 1 Then wsTarget.Cells(writeRow, 7).Value = CleanCSVField(CStr(dataArray(1)))
        If UBound(dataArray) >= 2 Then wsTarget.Cells(writeRow, 8).Value = CleanCSVField(CStr(dataArray(2)))
        If UBound(dataArray) >= 3 Then wsTarget.Cells(writeRow, 9).Value = CleanCSVField(CStr(dataArray(3)))
        If UBound(dataArray) >= 4 Then wsTarget.Cells(writeRow, 10).Value = CleanCSVField(CStr(dataArray(4)))
        If UBound(dataArray) >= 5 Then wsTarget.Cells(writeRow, 11).Value = CleanCSVField(CStr(dataArray(5)))
        If UBound(dataArray) >= 6 Then wsTarget.Cells(writeRow, 12).Value = CleanCSVField(CStr(dataArray(6)))
        If UBound(dataArray) >= 7 Then wsTarget.Cells(writeRow, 13).Value = CleanCSVField(CStr(dataArray(7)))
        If UBound(dataArray) >= 8 Then wsTarget.Cells(writeRow, 14).Value = CleanCSVField(CStr(dataArray(8)))
        If UBound(dataArray) >= 9 Then wsTarget.Cells(writeRow, 15).Value = CleanCSVField(CStr(dataArray(9)))
        If UBound(dataArray) >= 10 Then wsTarget.Cells(writeRow, 16).Value = CleanCSVField(CStr(dataArray(10)))
        
        ' Auto-fill D, E columns from 区間メンテナンス
        Call FillFromKukanMaster(wsTarget, writeRow, False)
        
        ' G列已有值 → 触发F下拉列表
        If Trim(wsTarget.Cells(writeRow, 7).Value) <> "" Then
            Call MakeFDropdownByG(wsTarget, writeRow)
        End If
        
        writeRow = writeRow + 1
NextLine:
    Next i
    
    MsgBox writeRow - 7 & " 行を取り込みました。", vbInformation
End Sub

Function CleanCSVField(ByVal field As Variant) As String
    If IsEmpty(field) Or IsNull(field) Then
        CleanCSVField = ""
        Exit Function
    End If
    
    Dim result As String
    result = Trim(CStr(field))
    
    If Len(result) >= 2 Then
        If Left(result, 1) = """" And Right(result, 1) = """" Then
            result = Mid(result, 2, Len(result) - 2)
            result = Replace(result, """""", """")
        End If
    End If
    CleanCSVField = result
End Function

Sub FillFromKukanMaster(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
    Dim code As String
    Dim deValue As String
    Dim fgValue As String
    
    On Error Resume Next
    Set wsKukan = ThisWorkbook.Worksheets("区間メンテナンス")
    
    If wsKukan Is Nothing Then Exit Sub
    
    code = Trim(ws.Cells(rowNum, 3).Value)
    If code = "" Then Exit Sub
    
    lastRow = wsKukan.Cells(wsKukan.Rows.Count, "C").End(xlUp).Row
    
    Dim found As Boolean
    found = False
    
    For i = 7 To lastRow
        If Trim(wsKukan.Cells(i, 3).Value) = code Then
            deValue = Trim(wsKukan.Cells(i, 4).Value) & ": " & Trim(wsKukan.Cells(i, 5).Value)
            ws.Cells(rowNum, 4).Value = deValue
            
            fgValue = Trim(wsKukan.Cells(i, 6).Value) & "~" & Trim(wsKukan.Cells(i, 7).Value)
            ws.Cells(rowNum, 5).Value = fgValue
            
            If setG Then
                ws.Cells(rowNum, 7).Value = "1"
                Call MakeFDropdownByG(ws, rowNum)
            End If
            
            found = True
            Exit For
        End If
    Next
    
    If Not found Then
        Call ClearRowData(ws, rowNum)
        Exit Sub
    End If
    

    
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, 17).ClearContents ' Q列错误信息
End Sub

Sub validateDetailData(ByVal ws As Worksheet, ByVal rowNum As Long, Optional ByVal isImport As Boolean = False)
    ' 关闭屏幕刷新和事件提升性能
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Dim cValue As String
    Dim jValue As String
    Dim kValue As String
    Dim lValue As String
    Dim mValue As String
    Dim nValue As String
    Dim oValue As String
    Dim pValue As String
    Dim gValue As String
    Dim hValue As String
    Dim iValue As String
    Dim i As Long
    Dim lastRow As Long
    Dim errorMsg As String
    
    cValue = Trim(ws.Cells(rowNum, 3).Value)
    If cValue = "" Then
        ws.Cells(rowNum, 17).Value = ""
            Exit Sub
    End If
    
    ' === J列和K列必须为数字（不能为空） ===
    jValue = Trim(ws.Cells(rowNum, 10).Value)
    kValue = Trim(ws.Cells(rowNum, 11).Value)
    
    If jValue = "" Then
        errorMsg = "J列は必須項目です。"
        ws.Cells(rowNum, 17).Value = errorMsg
        Exit Sub
    End If
    
    If Not IsNumeric(jValue) Then
        errorMsg = "J列には数値を入力してください。"
        ws.Cells(rowNum, 17).Value = errorMsg
        Exit Sub
    End If
    
    If kValue = "" Then
        errorMsg = "K列は必須項目です。"
        ws.Cells(rowNum, 17).Value = errorMsg
        Exit Sub
    End If
    
    If Not IsNumeric(kValue) Then
        errorMsg = "K列には数値を入力してください。"
        ws.Cells(rowNum, 17).Value = errorMsg
        Exit Sub
    End If
    
    ' === L、M、N、O、P列如果输入必须为数字 ===
    lValue = Trim(ws.Cells(rowNum, 12).Value)
    mValue = Trim(ws.Cells(rowNum, 13).Value)
    nValue = Trim(ws.Cells(rowNum, 14).Value)
    oValue = Trim(ws.Cells(rowNum, 15).Value)
    pValue = Trim(ws.Cells(rowNum, 16).Value)
    
    If lValue <> "" And Not IsNumeric(lValue) Then
        errorMsg = "L列には数値を入力してください。"
        ws.Cells(rowNum, 17).Value = errorMsg
        Exit Sub
    End If
    
    If mValue <> "" And Not IsNumeric(mValue) Then
        errorMsg = "M列には数値を入力してください。"
        ws.Cells(rowNum, 17).Value = errorMsg
        Exit Sub
    End If
    
    If nValue <> "" And Not IsNumeric(nValue) Then
        errorMsg = "N列には数値を入力してください。"
        ws.Cells(rowNum, 17).Value = errorMsg
        Exit Sub
    End If
    
    If oValue <> "" And Not IsNumeric(oValue) Then
        errorMsg = "O列には数値を入力してください。"
        ws.Cells(rowNum, 17).Value = errorMsg
        Exit Sub
    End If
    
    If pValue <> "" And Not IsNumeric(pValue) Then
        errorMsg = "P列には数値を入力してください。"
        ws.Cells(rowNum, 17).Value = errorMsg
        Exit Sub
    End If
    
    ' === G、H、I列联合主键检查重复 ===
    gValue = Trim(ws.Cells(rowNum, 7).Value)
    hValue = Trim(ws.Cells(rowNum, 8).Value)
    iValue = Trim(ws.Cells(rowNum, 9).Value)
    
    If gValue <> "" And hValue <> "" And iValue <> "" Then
        lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
        
        For i = 7 To lastRow
            If i <> rowNum Then
                If Trim(ws.Cells(i, 3).Value) = cValue Then
                    If Trim(ws.Cells(i, 7).Value) = gValue And _
                       Trim(ws.Cells(i, 8).Value) = hValue And _
                       Trim(ws.Cells(i, 9).Value) = iValue Then
                        errorMsg = "GHI列の組が既に存在します。"
                        ws.Cells(rowNum, 17).Value = errorMsg
                        Exit Sub
                    End If
                End If
            End If
        Next i
    End If
    
    ' 验证通过，清除Q列错误信息
    ws.Cells(rowNum, 17).Value = ""
    
    ' 恢复设置
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    
End Sub

' 按钮调用的宏（验证当前选中行）
Sub validateDetailDataButton()
    Dim rowNum As Long
    rowNum = ActiveCell.Row
    
    If rowNum < 7 Then
        MsgBox "データ行を選択してください。", vbExclamation
        Exit Sub
    End If
    
    Call validateDetailData(ActiveSheet, rowNum)
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
    
    If lastDataRow < 7 Then
        MsgBox "出力するデータ行がありません。", vbExclamation
        Exit Sub
    End If
    
    Dim savePath As String
    savePath = Application.GetSaveAsFilename( _
        FileFilter:="CSV Files (*.csv), *.csv", _
        Title:="CSV保存")
    
    If savePath = "False" Then Exit Sub
    If InStr(1, savePath, ".csv", vbTextCompare) = 0 Then
        savePath = savePath & ".csv"
    End If
    
    ' Header: 利用区間コード,券種,コード,名称,1箇月運賃/販売額,定期額/券１(額)/利用額,定期支給期間/券１(枚)/特別料金,特別料金/券２(額),券２(枚),端数(額),特別料金
    Dim headerList As Variant
    headerList = Array("利用区間コード", "券種", "コード", "名称", "1箇月運賃/販売額", "定期額/券１(額)/利用額", "定期支給期間/券１(枚)/特別料金", "特別料金/券２(額)", "券２(枚)", "端数(額)", "特別料金")
    
    ' Build CSV
    Dim csvContent As String
    Dim j As Long
    
    For j = 0 To UBound(headerList)
        If j > 0 Then csvContent = csvContent & ","
        csvContent = csvContent & headerList(j)
    Next j
    csvContent = csvContent & vbCrLf
    
    ' 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 Trim(ws.Cells(r, 3).Value) <> "" Then
            ' CSV col1 -> C列
            csvContent = csvContent & CleanCSVField(ws.Cells(r, 3).Value)
            ' CSV col2-11 -> G-P列
            For j = 7 To 16
                csvContent = csvContent & "," & CleanCSVField(ws.Cells(r, j).Value)
            Next j
            csvContent = csvContent & vbCrLf
        End If
    Next r
    
    ' 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出力が完了しました。", vbInformation
End Sub