add ninteiList
This commit is contained in:
@@ -82,6 +82,7 @@ Sub WriteCSVFromArray( _
|
||||
' Escape double quotes: "" represents a single "
|
||||
field = """" & Replace(field, """", """""") & """"
|
||||
End If
|
||||
field = GetCode(field)
|
||||
|
||||
fields(j - LBound(data, 2) + 1) = field
|
||||
Next j
|
||||
|
||||
@@ -30,6 +30,7 @@ Private oufukuList As Object
|
||||
Private koutaiList As Object
|
||||
Private higaitouList As Object
|
||||
Private kenshuList As Object
|
||||
Private ninteiKbnList As Object
|
||||
|
||||
Private sheetConfDict As Object
|
||||
|
||||
@@ -396,6 +397,24 @@ 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
|
||||
@@ -411,8 +430,8 @@ Private Sub RefreshSheetDict()
|
||||
sheetConf("RefreshCacheName") = ""
|
||||
sheetConf("CSV_Encoding") = "shift_jis"
|
||||
sheetConf("HasHeader") = True
|
||||
sheetConf("ExpectedColumnCount") = 54
|
||||
sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N")
|
||||
sheetConf("ExpectedColumnCount") = 41
|
||||
sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "W", "X", "Y", "Z", "AD", "AE", "AF", "AG", "AK", "AL", "AM", "AN", "AR", "AS", "AT", "AU", "AV", "AW", "AX", "AY", "AZ", "BA", "BB", "BC")
|
||||
sheetConf("AlwaysQuote") = False
|
||||
sheetConf("FilterRow") = 7
|
||||
|
||||
@@ -636,4 +655,9 @@ End Function
|
||||
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
|
||||
@@ -91,12 +91,14 @@ Private Sub Worksheet_Change(ByVal Target As Range)
|
||||
Dim intersectRng As Range: Set intersectRng = Application.Intersect(Target, watchArea)
|
||||
If intersectRng Is Nothing Then Exit Sub
|
||||
|
||||
If Target.Row < 7 Then Exit Sub
|
||||
If Target.Row < 8 Then Exit Sub
|
||||
Dim idx As Long
|
||||
|
||||
Application.EnableEvents = False
|
||||
On Error GoTo Finally
|
||||
|
||||
Call CreateNinteiDropdown(Target)
|
||||
|
||||
' === 3. rebuild dropdown list ===
|
||||
Call RebuildDropdownsForTarget(Target)
|
||||
|
||||
@@ -461,6 +463,33 @@ 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)
|
||||
@@ -788,5 +817,62 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
|
||||
End If
|
||||
Next kukanIdx
|
||||
|
||||
' Validate KUKAN_CODE_COLS for duplicates (non-empty only)
|
||||
Dim kukanCodes As Object: Set kukanCodes = CreateObject("Scripting.Dictionary")
|
||||
For kukanIdx = LBound(KUKAN_CODE_COLS) To UBound(KUKAN_CODE_COLS)
|
||||
kukanCol = KUKAN_CODE_COLS(kukanIdx)
|
||||
kukanCode = Trim(Me.Cells(rowNum, kukanCol).Value)
|
||||
If kukanCode <> "" Then
|
||||
If kukanCodes.Exists(kukanCode) Then
|
||||
kukanLetter = Split(Me.Cells(1, kukanCol).Address, "$")(1)
|
||||
Me.Cells(rowNum, errorCol).Value = kukanLetter & " column is duplicated"
|
||||
Me.Range(kukanLetter & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
Exit Sub
|
||||
Else
|
||||
kukanCodes.Add kukanCode, True
|
||||
End If
|
||||
End If
|
||||
Next kukanIdx
|
||||
|
||||
' Validate H, BB, BC columns
|
||||
Dim ColH As String: ColH = "H"
|
||||
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 code = "1", BB and BC must be empty
|
||||
If valBB <> "" Then
|
||||
Me.Cells(rowNum, errorCol).Value = ColBB & " column must be empty"
|
||||
Me.Range(ColBB & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
Exit Sub
|
||||
End If
|
||||
If valBC <> "" Then
|
||||
Me.Cells(rowNum, errorCol).Value = ColBC & " column must be empty"
|
||||
Me.Range(ColBC & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
Exit Sub
|
||||
End If
|
||||
ElseIf codeH = "2" Then
|
||||
' If code = "2", BB and BC must have value
|
||||
If valBB = "" Then
|
||||
Me.Cells(rowNum, errorCol).Value = ColBB & " column is required"
|
||||
Me.Range(ColBB & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
Exit Sub
|
||||
End If
|
||||
If valBC = "" Then
|
||||
Me.Cells(rowNum, errorCol).Value = ColBC & " column is required"
|
||||
Me.Range(ColBC & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
|
||||
Me.Cells(rowNum, errorCol).ClearContents
|
||||
End Sub
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user