Remove G column dropdown logic
This commit is contained in:
@@ -2,25 +2,6 @@
|
||||
Const CSV_HEADER As String = "利用区間コード,券種,コード,名称,1箇月運賃/販売額,定期額/券1(額)/利用額,定期支給期間/券1(枚)/特別料金,特別料金/券2(額),券2(枚),端数(額),特別料金"
|
||||
|
||||
Private Sub Worksheet_Change(ByVal Target As Range)
|
||||
' === Generate F dropdown based on G column (matching left of colon) ===
|
||||
If Target.Column = 7 And Target.Row >= 7 Then
|
||||
If Target.Count > 1 Then Exit Sub
|
||||
Call MakeFDropdownByG(Me, Target.Row)
|
||||
End If
|
||||
|
||||
' === Extract left of colon to G column when F changes ===
|
||||
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
|
||||
|
||||
' === Fill D, E when C column changes ===
|
||||
If Target.Column = 3 And Target.Row >= 7 Then
|
||||
Dim cell As Range
|
||||
@@ -57,7 +38,6 @@ Sub FillFromKukanMaster(ByVal ws As Worksheet, ByVal rowNum As Long, Optional By
|
||||
ws.Cells(rowNum, 8).Value = Trim(wsKukan.Cells(i, 14).Value)
|
||||
If setG Then
|
||||
ws.Cells(rowNum, 7).Value = "1"
|
||||
Call MakeFDropdownByG(ws, rowNum)
|
||||
End If
|
||||
Exit Sub
|
||||
End If
|
||||
@@ -74,66 +54,7 @@ Sub ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long)
|
||||
ws.Cells(rowNum, 19).ClearContents ' Q column error info
|
||||
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("Kotsu_Master")
|
||||
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
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -251,9 +172,7 @@ NextCsvLine:
|
||||
Call FillFromKukanMaster(wsTarget, writeRow, False)
|
||||
|
||||
' G column has value → trigger F dropdown
|
||||
If Trim(wsTarget.Cells(writeRow, 7).Value) <> "" Then
|
||||
Call MakeFDropdownByG(wsTarget, writeRow)
|
||||
End If
|
||||
|
||||
|
||||
writeRow = writeRow + 1
|
||||
NextLine:
|
||||
|
||||
Reference in New Issue
Block a user