delete ninteiList and add optional button

This commit is contained in:
updsv7
2026-04-20 18:03:03 +09:00
parent 72566e3e03
commit 5c40eb4381
4 changed files with 7 additions and 63 deletions

View File

@@ -30,6 +30,10 @@ Sub Fit_Button()
Do_Fit ActiveSheet
End Sub
Sub RefreshCache_Button()
' 重新加载所有缓存
End Sub
Private Sub DO_CSV_Import(ws As Excel.Worksheet)
On Error GoTo ImportError

View File

@@ -30,7 +30,6 @@ Private oufukuList As Object
Private koutaiList As Object
Private higaitouList As Object
Private kenshuList As Object
Private ninteiKbnList As Object
Private sheetConfDict As Object
@@ -397,24 +396,6 @@ RefreshError:
Err.Raise 1001, "RefreshKenshuList", "Failed to load Enum lookup cache: " & Err.Description
End Sub
' ============================================================
' ninteiKbnList
' ============================================================
Private Sub RefreshNinteiKbnList()
On Error GoTo RefreshError
Set ninteiKbnList = LoadLookup("Enum", keyCol:=15, valueCols:=Array(16), startRow:=3)
On Error GoTo 0
If ninteiKbnList Is Nothing Or ninteiKbnList.Count = 0 Then
Err.Raise 1003, "RefreshNinteiKbnList", "Enum reference data is empty"
End If
Exit Sub
RefreshError:
Err.Raise 1001, "RefreshNinteiKbnList", "Failed to load Enum lookup cache: " & Err.Description
End Sub
Private Sub RefreshSheetDict()
Set sheetConfDict = CreateObject("Scripting.Dictionary")
Dim sheetConf As Object
@@ -656,8 +637,3 @@ Public Function GetKenshuList() As Object
If kenshuList Is Nothing Then Call RefreshKenshuList
Set GetKenshuList = kenshuList
End Function
Public Function GetNinteiKbnList() As Object
If ninteiKbnList Is Nothing Then Call RefreshNinteiKbnList
Set GetNinteiKbnList = ninteiKbnList
End Function

View File

@@ -97,8 +97,6 @@ Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
On Error GoTo Finally
Call CreateNinteiDropdown(Target)
' === 3. rebuild dropdown list ===
Call RebuildDropdownsForTarget(Target)
@@ -463,33 +461,6 @@ Private Sub CreateKenshuDropdown(ByVal rowNum As Long, ByVal idx As Long, ByVal
End With
End Sub
' Create Nintei dropdown from ninteiKbnList if H3 cell Validation does not exist
Private Sub CreateNinteiDropdown(ByVal Target As Range)
Dim ninteiKbnList As Object: Set ninteiKbnList = GetNinteiKbnList()
' Build dropdown list from ninteiKbnList
Dim dropdownList As String
Dim key As Variant
For Each key In ninteiKbnList.Keys
Dim displayText As String
displayText = MakeSelect(key, ninteiKbnList(key)(0))
If dropdownList = "" Then
dropdownList = displayText
Else
dropdownList = dropdownList & "," & displayText
End If
Next key
If dropdownList <> "" Then
With Me.Range("H3").Validation
.Delete
.Add Type:=xlValidateList, Formula1:=dropdownList
.IgnoreBlank = True
.InCellDropdown = True
End With
End If
End Sub
' Create destination dropdown from M1_KukanD cache
' Structure: { D: { F: [G] } }
Private Sub CreateToStationDropdown(ByVal rowNum As Long, ByVal transportCol As Long, ByVal stationFromCol As Long, ByVal stationToCol As Long)
@@ -835,20 +806,13 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
Next kukanIdx
' Validate H, BB, BC columns
Dim ColH As String: ColH = "H"
Dim linkCellValue As String: linkCellValue = Me.Cells(3, "H").Value
Dim ColBB As String: ColBB = "BB"
Dim ColBC As String: ColBC = "BC"
Dim codeH As String: codeH = GetCode(Trim(Me.Cells(3, ColH).Value))
Dim valBB As String: valBB = Trim(Me.Cells(rowNum, ColBB).Value)
Dim valBC As String: valBC = Trim(Me.Cells(rowNum, ColBC).Value)
Me.Range("H3").Interior.Color = vbWhite
If codeH = "" Then
MsgBox "Please select cell " & ColH & "3 column", vbExclamation
Me.Range("H3").Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If codeH = "1" Then
If linkCellValue = "1" Then
' If code = "1", BB and BC must be empty
If valBB <> "" Then
Me.Cells(rowNum, errorCol).Value = ColBB & " column must be empty"
@@ -860,7 +824,7 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
Me.Range(ColBC & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
ElseIf codeH = "2" Then
ElseIf linkCellValue = "2" Then
' If code = "2", BB and BC must have value
If valBB = "" Then
Me.Cells(rowNum, errorCol).Value = ColBB & " column is required"