add ninteiList
This commit is contained in:
@@ -82,6 +82,7 @@ Sub WriteCSVFromArray( _
|
|||||||
' Escape double quotes: "" represents a single "
|
' Escape double quotes: "" represents a single "
|
||||||
field = """" & Replace(field, """", """""") & """"
|
field = """" & Replace(field, """", """""") & """"
|
||||||
End If
|
End If
|
||||||
|
field = GetCode(field)
|
||||||
|
|
||||||
fields(j - LBound(data, 2) + 1) = field
|
fields(j - LBound(data, 2) + 1) = field
|
||||||
Next j
|
Next j
|
||||||
|
|||||||
@@ -30,6 +30,7 @@ Private oufukuList As Object
|
|||||||
Private koutaiList As Object
|
Private koutaiList As Object
|
||||||
Private higaitouList As Object
|
Private higaitouList As Object
|
||||||
Private kenshuList As Object
|
Private kenshuList As Object
|
||||||
|
Private ninteiKbnList As Object
|
||||||
|
|
||||||
Private sheetConfDict As Object
|
Private sheetConfDict As Object
|
||||||
|
|
||||||
@@ -396,6 +397,24 @@ RefreshError:
|
|||||||
Err.Raise 1001, "RefreshKenshuList", "Failed to load Enum lookup cache: " & Err.Description
|
Err.Raise 1001, "RefreshKenshuList", "Failed to load Enum lookup cache: " & Err.Description
|
||||||
End Sub
|
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()
|
Private Sub RefreshSheetDict()
|
||||||
Set sheetConfDict = CreateObject("Scripting.Dictionary")
|
Set sheetConfDict = CreateObject("Scripting.Dictionary")
|
||||||
Dim sheetConf As Object
|
Dim sheetConf As Object
|
||||||
@@ -411,8 +430,8 @@ Private Sub RefreshSheetDict()
|
|||||||
sheetConf("RefreshCacheName") = ""
|
sheetConf("RefreshCacheName") = ""
|
||||||
sheetConf("CSV_Encoding") = "shift_jis"
|
sheetConf("CSV_Encoding") = "shift_jis"
|
||||||
sheetConf("HasHeader") = True
|
sheetConf("HasHeader") = True
|
||||||
sheetConf("ExpectedColumnCount") = 54
|
sheetConf("ExpectedColumnCount") = 41
|
||||||
sheetConf("HeaderColumns") = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N")
|
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("AlwaysQuote") = False
|
||||||
sheetConf("FilterRow") = 7
|
sheetConf("FilterRow") = 7
|
||||||
|
|
||||||
@@ -636,4 +655,9 @@ End Function
|
|||||||
Public Function GetKenshuList() As Object
|
Public Function GetKenshuList() As Object
|
||||||
If kenshuList Is Nothing Then Call RefreshKenshuList
|
If kenshuList Is Nothing Then Call RefreshKenshuList
|
||||||
Set GetKenshuList = kenshuList
|
Set GetKenshuList = kenshuList
|
||||||
|
End Function
|
||||||
|
|
||||||
|
Public Function GetNinteiKbnList() As Object
|
||||||
|
If ninteiKbnList Is Nothing Then Call RefreshNinteiKbnList
|
||||||
|
Set GetNinteiKbnList = ninteiKbnList
|
||||||
End Function
|
End Function
|
||||||
@@ -91,12 +91,14 @@ Private Sub Worksheet_Change(ByVal Target As Range)
|
|||||||
Dim intersectRng As Range: Set intersectRng = Application.Intersect(Target, watchArea)
|
Dim intersectRng As Range: Set intersectRng = Application.Intersect(Target, watchArea)
|
||||||
If intersectRng Is Nothing Then Exit Sub
|
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
|
Dim idx As Long
|
||||||
|
|
||||||
Application.EnableEvents = False
|
Application.EnableEvents = False
|
||||||
On Error GoTo Finally
|
On Error GoTo Finally
|
||||||
|
|
||||||
|
Call CreateNinteiDropdown(Target)
|
||||||
|
|
||||||
' === 3. rebuild dropdown list ===
|
' === 3. rebuild dropdown list ===
|
||||||
Call RebuildDropdownsForTarget(Target)
|
Call RebuildDropdownsForTarget(Target)
|
||||||
|
|
||||||
@@ -461,6 +463,33 @@ Private Sub CreateKenshuDropdown(ByVal rowNum As Long, ByVal idx As Long, ByVal
|
|||||||
End With
|
End With
|
||||||
End Sub
|
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
|
' Create destination dropdown from M1_KukanD cache
|
||||||
' Structure: { D: { F: [G] } }
|
' Structure: { D: { F: [G] } }
|
||||||
Private Sub CreateToStationDropdown(ByVal rowNum As Long, ByVal transportCol As Long, ByVal stationFromCol As Long, ByVal stationToCol As Long)
|
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
|
End If
|
||||||
Next kukanIdx
|
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
|
Me.Cells(rowNum, errorCol).ClearContents
|
||||||
End Sub
|
End Sub
|
||||||
|
|||||||
Binary file not shown.
Reference in New Issue
Block a user