通勤認定エクセルツール対応11
This commit is contained in:
guanxiangwei
@@ -21,37 +21,42 @@
|
||||
Const CSHAINNO_COL As String = "C"
|
||||
Const ADDRESS1_COL As String = "I"
|
||||
Const ADDRESS2_COL As String = "J"
|
||||
Const MMONTH_AMOUNT_KBN_COL As String = "BB"
|
||||
|
||||
Private Function KUKAN_CODE_COLS() As Variant
|
||||
KUKAN_CODE_COLS = Array(19, 26, 33, 40) ' S, Z, AG, AN
|
||||
KUKAN_CODE_COLS = Array(19, 27, 35, 43) ' S, AA, AI, AQ
|
||||
End Function
|
||||
|
||||
Private Function KUKAN_TRANSPORT_COLS() As Variant
|
||||
KUKAN_TRANSPORT_COLS = Array(20, 27, 34, 41) ' T, AA, AH, AO
|
||||
KUKAN_TRANSPORT_COLS = Array(20, 28, 36, 44) ' T, AB, AJ, AR
|
||||
End Function
|
||||
|
||||
Private Function KUKAN_STATION_COLS() As Variant
|
||||
KUKAN_STATION_COLS = Array(21, 28, 35, 42) ' U, AB, AI, AP
|
||||
KUKAN_STATION_COLS = Array(21, 29, 37, 45) ' U, AC, AK, AS
|
||||
End Function
|
||||
|
||||
Private Function KUKAN_ARRIVAL_COLS() As Variant
|
||||
KUKAN_ARRIVAL_COLS = Array(22, 29, 36, 43) ' V, AC, AJ, AQ
|
||||
KUKAN_ARRIVAL_COLS = Array(22, 30, 38, 46) ' V, AD, AL, AT
|
||||
End Function
|
||||
|
||||
Private Function KUKAN_TICKET_COLS() As Variant
|
||||
KUKAN_TICKET_COLS = Array(23, 30, 37, 44) ' W, AD, AK, AR
|
||||
KUKAN_TICKET_COLS = Array(23, 31, 39, 47) ' W, AE, AM, AU
|
||||
End Function
|
||||
|
||||
Private Function KUKAN_CODE2_COLS() As Variant
|
||||
KUKAN_CODE2_COLS = Array(24, 31, 38, 45) ' X, AE, AL, AS
|
||||
KUKAN_CODE2_COLS = Array(24, 32, 40, 48) ' X, AF, AN, AV
|
||||
End Function
|
||||
|
||||
Private Function KUKAN_TEIKI_COLS() As Variant
|
||||
KUKAN_TEIKI_COLS = Array(25, 33, 41, 49) ' Y, AG, AO, AW
|
||||
End Function
|
||||
|
||||
Private Function KUKAN_START_DAY_COLS() As Variant
|
||||
KUKAN_START_DAY_COLS = Array(25, 32, 39, 46) ' Y, AF, AM, AT
|
||||
KUKAN_START_DAY_COLS = Array(26, 34, 42, 50) ' Z, AH, AP, AX
|
||||
End Function
|
||||
|
||||
Private Function DATE_COLS() As Variant
|
||||
DATE_COLS = Array(4, 5, 6, 25, 32, 39, 46, 51, 54) ' D, E, F, Y, AF, AM, AT, AY, BB
|
||||
DATE_COLS = Array(4, 5, 6, 26, 34, 42, 50, 56, 59) ' D, E, F, Z, AH, AP, AX, BC, BF
|
||||
End Function
|
||||
|
||||
Private Function NUMBER_COLS() As Variant
|
||||
@@ -89,11 +94,10 @@ Private Sub Worksheet_Change(ByVal Target As Range)
|
||||
.Columns("F"), _
|
||||
.Columns("G"), _
|
||||
.Columns("I"), _
|
||||
.Columns("S:W"), _
|
||||
.Columns("Z:AD"), _
|
||||
.Columns("AG:AK"), _
|
||||
.Columns("AN:AR"), _
|
||||
.Columns("BB") _
|
||||
.Columns("S:X"), _
|
||||
.Columns("AA:AF"), _
|
||||
.Columns("AI:AN"), _
|
||||
.Columns("AQ:AV") _
|
||||
)
|
||||
End With
|
||||
Dim intersectRng As Range: Set intersectRng = Application.Intersect(Target, watchArea)
|
||||
@@ -167,7 +171,7 @@ Private Sub Worksheet_Change(ByVal Target As Range)
|
||||
Next
|
||||
End If
|
||||
|
||||
' === Transport column changes (T, AA, AH, AO) ===
|
||||
' === Transport column changes (T, AB, AJ, AR) ===
|
||||
idx = GetIdx(Target.Column, KUKAN_TRANSPORT_COLS)
|
||||
If idx >= 0 Then
|
||||
Dim cellT As Range
|
||||
@@ -180,7 +184,7 @@ Private Sub Worksheet_Change(ByVal Target As Range)
|
||||
Next
|
||||
End If
|
||||
|
||||
' === Station column changes (U, AB, AI, AP) ===
|
||||
' === Station column changes (U, AC, AK, AS) ===
|
||||
idx = GetIdx(Target.Column, KUKAN_STATION_COLS)
|
||||
If idx >= 0 Then
|
||||
Dim cellU As Range
|
||||
@@ -193,7 +197,7 @@ Private Sub Worksheet_Change(ByVal Target As Range)
|
||||
Next
|
||||
End If
|
||||
|
||||
' === Arrival column changes (V, AC, AJ, AQ) ===
|
||||
' === Arrival column changes (V, AD, AL, AT) ===
|
||||
idx = GetIdx(Target.Column, KUKAN_ARRIVAL_COLS)
|
||||
If idx >= 0 Then
|
||||
Dim cellV As Range
|
||||
@@ -210,7 +214,7 @@ Private Sub Worksheet_Change(ByVal Target As Range)
|
||||
Next
|
||||
End If
|
||||
|
||||
' === Kukan code column changes (S, Z, AG, AN) ===
|
||||
' === Kukan code column changes (S, AA, AI, AQ) ===
|
||||
idx = GetIdx(Target.Column, KUKAN_CODE_COLS)
|
||||
If idx >= 0 Then
|
||||
Dim cellK As Range
|
||||
@@ -219,7 +223,7 @@ Private Sub Worksheet_Change(ByVal Target As Range)
|
||||
Next
|
||||
End If
|
||||
|
||||
' === Ticket column changes (W, AD, AK, AR) ===
|
||||
' === Ticket column changes (W, AE, AM, AU) ===
|
||||
idx = GetIdx(Target.Column, KUKAN_TICKET_COLS)
|
||||
If idx >= 0 Then
|
||||
Dim cellTi As Range
|
||||
@@ -228,7 +232,22 @@ Private Sub Worksheet_Change(ByVal Target As Range)
|
||||
Dim code2Col As Long: code2Col = KUKAN_CODE2_COLS(idx)
|
||||
Me.Cells(cellTi.Row, code2Col).ClearContents
|
||||
Me.Cells(cellTi.Row, code2Col).Validation.Delete
|
||||
Call CreateM2CodeDropdown(cellTi.Row, KUKAN_CODE_COLS(idx), KUKAN_TICKET_COLS(idx), code2Col)
|
||||
' Also clear teiki column
|
||||
Dim teikiCol As Long: teikiCol = KUKAN_TEIKI_COLS(idx)
|
||||
Me.Cells(cellTi.Row, teikiCol).ClearContents
|
||||
Me.Cells(cellTi.Row, teikiCol).Validation.Delete
|
||||
Call BuildM2CodeDropdown(cellTi.Row, KUKAN_CODE_COLS(idx), KUKAN_TICKET_COLS(idx), code2Col)
|
||||
Next
|
||||
End If
|
||||
|
||||
' === Code2 column changes (X, AF, AN, AV) ===
|
||||
idx = GetIdx(Target.Column, KUKAN_CODE2_COLS)
|
||||
If idx >= 0 Then
|
||||
Dim cellCode2 As Range
|
||||
For Each cellCode2 In Target
|
||||
If Trim(cellCode2.Value) <> "" Then
|
||||
Call CreateTeikiDropdown(cellCode2.Row, idx)
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
|
||||
@@ -266,7 +285,22 @@ Private Sub Refresh(ws As Worksheet, ByVal startRow As Long, ByVal lastDataRow A
|
||||
Call BuildAddress2Dropdown(r, cshainno)
|
||||
Call ReFillAddress2(r, cshainno)
|
||||
Call RebuildDropdowns(r)
|
||||
|
||||
Call ReFillFromDropdowns(r)
|
||||
|
||||
' Refresh teiki dropdowns for all 4 sections
|
||||
Dim idx As Long
|
||||
For idx = 0 To 3
|
||||
Dim kukanCode As String: kukanCode = Trim(Me.Cells(r, KUKAN_CODE_COLS(idx)).Value)
|
||||
Dim kenshu As String: kenshu = GetCode(Trim(Me.Cells(r, KUKAN_TICKET_COLS(idx)).Value))
|
||||
Dim code As String: code = GetCode(Trim(Me.Cells(r, KUKAN_CODE2_COLS(idx)).Value))
|
||||
Call BuildM2CodeDropdown(r, KUKAN_CODE_COLS(idx), KUKAN_TICKET_COLS(idx), KUKAN_CODE2_COLS(idx))
|
||||
Call ReFillM2CodeDropdown(r, KUKAN_CODE_COLS(idx), KUKAN_TICKET_COLS(idx), KUKAN_CODE2_COLS(idx))
|
||||
If kukanCode <> "" And kenshu <> "" And code <> "" Then
|
||||
Dim teikiColIndex As Long: teikiColIndex = KUKAN_TEIKI_COLS(idx)
|
||||
Call BuildTeikiDropdown(r, kukanCode, kenshu, code, ColLetter(teikiColIndex))
|
||||
End If
|
||||
Next idx
|
||||
Next r
|
||||
|
||||
Application.EnableEvents = True
|
||||
@@ -281,16 +315,15 @@ Private Sub RebuildDropdowns(ByVal rowNum As Long)
|
||||
Dim dropdowns As Variant
|
||||
dropdowns = Array( _
|
||||
Array("T", "BuildTransportList"), _
|
||||
Array("AA", "BuildTransportList"), _
|
||||
Array("AH", "BuildTransportList"), _
|
||||
Array("AO", "BuildTransportList"), _
|
||||
Array("AB", "BuildTransportList"), _
|
||||
Array("AJ", "BuildTransportList"), _
|
||||
Array("AR", "BuildTransportList"), _
|
||||
Array("G", "BuildTodokeList"), _
|
||||
Array("M", "BuildOufukuList"), _
|
||||
Array("N", "BuildKoutaiList"), _
|
||||
Array("AU", "BuildKetteiList"), _
|
||||
Array("AW", "BuildHigaitouList"), _
|
||||
Array("AX", "BuildMonthAmountKbnList"), _
|
||||
Array("BC", "BuildKanshokuList") _
|
||||
Array("AY", "BuildKetteiList"), _
|
||||
Array("BA", "BuildHigaitouList"), _
|
||||
Array("BG", "BuildKanshokuList") _
|
||||
)
|
||||
|
||||
Dim i As Long
|
||||
@@ -302,22 +335,32 @@ Private Sub RebuildDropdowns(ByVal rowNum As Long)
|
||||
.InCellDropdown = True
|
||||
End With
|
||||
Next i
|
||||
|
||||
Call BuildDropdownFromCacheNamedRange(Me, MMONTH_AMOUNT_KBN_COL, rowNum, "Z3")
|
||||
|
||||
End Sub
|
||||
|
||||
Private Sub ReFillFromDropdowns(ByVal rowNum As Long)
|
||||
|
||||
Dim z3Cache As Object: Set z3Cache = GetCache("Z3")
|
||||
Dim valueStrMonthAmountKbn As String: valueStrMonthAmountKbn = Trim(Me.Cells(rowNum, MMONTH_AMOUNT_KBN_COL).Value)
|
||||
Dim monthAmountKbn As String: monthAmountKbn = GetCode(valueStrMonthAmountKbn)
|
||||
If z3Cache.Exists(monthAmountKbn) Then
|
||||
Me.Cells(rowNum, MMONTH_AMOUNT_KBN_COL).Value = MakeSelect(monthAmountKbn, z3Cache(monthAmountKbn)(0))
|
||||
End If
|
||||
|
||||
Dim dropdowns As Variant
|
||||
dropdowns = Array( _
|
||||
Array("T", "BuildTransportList"), _
|
||||
Array("AA", "BuildTransportList"), _
|
||||
Array("AH", "BuildTransportList"), _
|
||||
Array("AO", "BuildTransportList"), _
|
||||
Array("AB", "BuildTransportList"), _
|
||||
Array("AJ", "BuildTransportList"), _
|
||||
Array("AR", "BuildTransportList"), _
|
||||
Array("G", "BuildTodokeList"), _
|
||||
Array("M", "BuildOufukuList"), _
|
||||
Array("N", "BuildKoutaiList"), _
|
||||
Array("AU", "BuildKetteiList"), _
|
||||
Array("AW", "BuildHigaitouList"), _
|
||||
Array("AX", "BuildMonthAmountKbnList"), _
|
||||
Array("BC", "BuildKanshokuList") _
|
||||
Array("AY", "BuildKetteiList"), _
|
||||
Array("BA", "BuildHigaitouList"), _
|
||||
Array("BG", "BuildKanshokuList") _
|
||||
)
|
||||
|
||||
Dim i As Long
|
||||
@@ -645,9 +688,9 @@ Private Sub ClearKukanValidation(ByVal rowNum As Long, ByVal col As Long)
|
||||
End Sub
|
||||
|
||||
' Create dropdown from M2 cache: get code (J) list for kukanCode + kanshu
|
||||
Private Sub CreateM2CodeDropdown(ByVal rowNum As Long, ByVal kukanCodeCol As Long, ByVal kanshuCol As Long, ByVal codeCol As Long)
|
||||
Private Sub BuildM2CodeDropdown(ByVal rowNum As Long, ByVal kukanCodeCol As Long, ByVal kanshuCol As Long, ByVal codeCol As Long)
|
||||
Dim m2Cache As Object: Set m2Cache = GetCache("M2")
|
||||
|
||||
|
||||
Dim kukanCode As String: kukanCode = Trim(Me.Cells(rowNum, kukanCodeCol).Value)
|
||||
Dim kanshuStr As String: kanshuStr = Trim(Me.Cells(rowNum, kanshuCol).Value)
|
||||
If kukanCode = "" Or kanshuStr = "" Then Exit Sub
|
||||
@@ -661,10 +704,12 @@ Private Sub CreateM2CodeDropdown(ByVal rowNum As Long, ByVal kukanCodeCol As Lon
|
||||
Dim innermostDict As Object: Set innermostDict = innerDict(kanshu)
|
||||
Dim code As Variant
|
||||
For Each code In innermostDict.Keys
|
||||
Dim infoDict As Object: Set infoDict = innermostDict(code)
|
||||
Dim codeName As String: codeName = infoDict("name")
|
||||
If dropdownList = "" Then
|
||||
dropdownList = MakeSelect(code, innermostDict(code))
|
||||
dropdownList = MakeSelect(code, codeName)
|
||||
Else
|
||||
dropdownList = dropdownList & "," & code
|
||||
dropdownList = dropdownList & "," & MakeSelect(code, codeName)
|
||||
End If
|
||||
Next code
|
||||
End If
|
||||
@@ -680,25 +725,44 @@ Private Sub CreateM2CodeDropdown(ByVal rowNum As Long, ByVal kukanCodeCol As Lon
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub ReFillM2CodeDropdown(ByVal rowNum As Long, ByVal kukanCodeCol As Long, ByVal kanshuCol As Long, ByVal codeCol As Long)
|
||||
Dim m2Cache As Object: Set m2Cache = GetCache("M2")
|
||||
|
||||
Dim kukanCode As String: kukanCode = Trim(Me.Cells(rowNum, kukanCodeCol).Value)
|
||||
Dim kenshu As String: kenshu = GetCode(Trim(Me.Cells(rowNum, kanshuCol).Value))
|
||||
If kukanCode = "" Or kenshu = "" Then
|
||||
Me.Cells(rowNum, codeCol).ClearContents
|
||||
Me.Cells(rowNum, codeCol).Validation.Delete
|
||||
Me.Cells(rowNum, codeCol).Interior.Color = vbWhite
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Dim code As String: code = GetCode(Trim(Me.Cells(rowNum, codeCol).Value))
|
||||
If m2Cache.Exists(kukanCode) Then
|
||||
Dim innerDict As Object: Set innerDict = m2Cache(kukanCode)
|
||||
If innerDict.Exists(kenshu) Then
|
||||
Dim innermostDict As Object: Set innermostDict = innerDict(kenshu)
|
||||
If innermostDict.Exists(code) Then
|
||||
Dim infoDict As Object: Set infoDict = innermostDict(code)
|
||||
Dim codeName As String: codeName = infoDict("name")
|
||||
Me.Cells(rowNum, codeCol).Value = MakeSelect(code, codeName)
|
||||
End IF
|
||||
End If
|
||||
End If
|
||||
|
||||
End Sub
|
||||
|
||||
' Clear row data and validation
|
||||
Private Sub ClearRowData(ByVal rowNum As Long)
|
||||
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
|
||||
Dim sheetConf As Object: Set sheetConf = sheetConfDict(Me.CodeName)
|
||||
|
||||
Dim startCol As String: startCol = sheetConf("StartCol")
|
||||
Dim startCol As String: startCol = sheetConf("ErrorCol")
|
||||
Dim endCol As String: endCol = sheetConf("EndCol")
|
||||
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
|
||||
|
||||
Me.Range(Me.Cells(rowNum, startCol), Me.Cells(rowNum, endCol)).ClearContents
|
||||
Me.Range(Me.Cells(rowNum, startCol), Me.Cells(rowNum, endCol)).Validation.Delete
|
||||
Me.Range(Me.Cells(rowNum, startCol), Me.Cells(rowNum, endCol)).Interior.Color = vbWhite
|
||||
Me.Cells(rowNum, errorCol).ClearContents
|
||||
|
||||
Dim clearValidationCols As Variant
|
||||
clearValidationCols = Array("I", "J", "U", "V", "X", "AB", "AC", "AE", "AI", "AJ", "AL", "AP", "AQ", "AS")
|
||||
Dim col As Variant
|
||||
For Each col In clearValidationCols
|
||||
Me.Range(col & rowNum).Validation.Delete
|
||||
Next col
|
||||
End Sub
|
||||
|
||||
' Validation logic
|
||||
@@ -717,7 +781,7 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
|
||||
|
||||
' Required columns: C-G, K-N, AW
|
||||
Dim requiredCols As Variant
|
||||
requiredCols = Array("C", "D", "E", "F", "G", "L", "M", "N", "AW")
|
||||
requiredCols = Array("C", "D", "E", "F", "G", "L", "M", "N", "BA")
|
||||
Dim col As Variant
|
||||
For Each col In requiredCols
|
||||
If Trim(Me.Range(col & rowNum).Value & "") = "" Then
|
||||
@@ -847,6 +911,7 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
|
||||
' Validate KUKAN_TICKET_COLS and KUKAN_CODE2_COLS
|
||||
Dim ticketCol As Long: ticketCol = KUKAN_TICKET_COLS(kukanIdx)
|
||||
Dim code2Col As Long: code2Col = KUKAN_CODE2_COLS(kukanIdx)
|
||||
Dim teikiCol As Long: teikiCol = KUKAN_TEIKI_COLS(kukanIdx)
|
||||
Dim ticketVal As String: ticketVal = GetCode(Trim(Me.Cells(rowNum, ticketCol).Value))
|
||||
Dim code2Val As String: code2Val = GetCode(Trim(Me.Cells(rowNum, code2Col).Value))
|
||||
Dim ticketLetter As String: ticketLetter = Split(Me.Cells(1, ticketCol).Address, "$")(1)
|
||||
@@ -886,6 +951,14 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
|
||||
Me.Cells(rowNum, errorCol).Value = code2Letter & " column is invalid"
|
||||
Me.Range(code2Letter & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
Exit Sub
|
||||
Else
|
||||
Dim teikiValue As String: teikiValue = Trim(Me.Cells(rowNum, teikiCol).Value)
|
||||
If ticketVal = "1" And teikiValue = "" Then
|
||||
Dim teikiLetter As String: teikiLetter = ColLetter(teikiCol)
|
||||
Me.Cells(rowNum, errorCol).Value = teikiLetter & " column is required"
|
||||
Me.Range(teikiLetter & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
@@ -925,33 +998,33 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
|
||||
|
||||
' Validate H, BB, BC columns
|
||||
Dim linkCellValue As String: linkCellValue = Me.Cells(3, "H").Value
|
||||
Dim ColBB As String: ColBB = "BB"
|
||||
Dim ColBC As String: ColBC = "BC"
|
||||
Dim valBB As String: valBB = Trim(Me.Cells(rowNum, ColBB).Value)
|
||||
Dim valBC As String: valBC = Trim(Me.Cells(rowNum, ColBC).Value)
|
||||
Dim ColBF As String: ColBF = "BF"
|
||||
Dim ColBG As String: ColBG = "BG"
|
||||
Dim valBF As String: valBF = Trim(Me.Cells(rowNum, ColBF).Value)
|
||||
Dim valBG As String: valBG = Trim(Me.Cells(rowNum, ColBG).Value)
|
||||
|
||||
If linkCellValue = "1" Then
|
||||
' If code = "1", BB and BC must be empty
|
||||
If valBB <> "" Then
|
||||
Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E005", ColBB & rowNum)
|
||||
Me.Range(ColBB & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
If valBF <> "" Then
|
||||
Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E005", ColBF & rowNum)
|
||||
Me.Range(ColBF & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
Exit Sub
|
||||
End If
|
||||
If valBC <> "" Then
|
||||
Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E005", ColBC & rowNum)
|
||||
Me.Range(ColBC & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
If valBG <> "" Then
|
||||
Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E005", ColBG & rowNum)
|
||||
Me.Range(ColBG & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
Exit Sub
|
||||
End If
|
||||
ElseIf linkCellValue = "2" Then
|
||||
' If code = "2", BB and BC must have value
|
||||
If valBB = "" Then
|
||||
Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E002", ColBB & rowNum)
|
||||
Me.Range(ColBB & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
If valBF = "" Then
|
||||
Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E002", ColBF & rowNum)
|
||||
Me.Range(ColBF & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
Exit Sub
|
||||
End If
|
||||
If valBC = "" Then
|
||||
Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E002", ColBC & rowNum)
|
||||
Me.Range(ColBC & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
If valBG = "" Then
|
||||
Me.Cells(rowNum, errorCol).Value = GetErrorMsg("E002", ColBG & rowNum)
|
||||
Me.Range(ColBG & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
@@ -962,3 +1035,57 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
|
||||
ErrHandler:
|
||||
lastErrorMsg = Err.Description
|
||||
End Sub
|
||||
|
||||
' Create teiki dropdown based on M2 cache
|
||||
Private Sub CreateTeikiDropdown(ByVal row As Long, ByVal idx As Long)
|
||||
' Get kukanCode from KUKAN_CODE_COLS
|
||||
Dim kukanCol As Long: kukanCol = KUKAN_CODE_COLS(idx)
|
||||
Dim kukanCode As String: kukanCode = Trim(Me.Cells(row, kukanCol).Value)
|
||||
' Get kenshu from KUKAN_TICKET_COLS
|
||||
Dim kenshu As String: kenshu = GetCode(Trim(Me.Cells(row, KUKAN_TICKET_COLS(idx)).Value))
|
||||
' Get code2 from KUKAN_CODE2_COLS
|
||||
Dim code As String: code = GetCode(Trim(Me.Cells(row, KUKAN_CODE2_COLS(idx)).Value))
|
||||
|
||||
If kukanCode = "" Or kenshu = "" Or code = "" Then Exit Sub
|
||||
If Not kenshu = "1" Then Exit Sub
|
||||
|
||||
Dim teikiColIndex As Long: teikiColIndex = KUKAN_TEIKI_COLS(idx)
|
||||
Call BuildTeikiDropdown(row, kukanCode, kenshu, code, ColLetter(teikiColIndex))
|
||||
End Sub
|
||||
|
||||
Private Sub BuildTeikiDropdown(ByVal rowNum As Long, ByVal kukanCode As String, ByVal kenshu As String, ByVal code As String, ByVal targetCell As String)
|
||||
Dim M2Cache As Object: Set M2Cache = GetCache("M2")
|
||||
Dim kenshuDict As Object: Set kenshuDict = M2Cache(kukanCode)
|
||||
Dim codeDict As Object: Set codeDict = kenshuDict(kenshu)
|
||||
Dim teikiArray As Object: Set teikiArray = codeDict(code)
|
||||
|
||||
If teikiArray Is Nothing Then Exit Sub
|
||||
If Not teikiArray.Exists("teikikikanNum") Then Exit Sub
|
||||
|
||||
Dim teikiList As Variant: teikiList = teikiArray("teikikikanNum")
|
||||
If Not IsArray(teikiList) Then Exit Sub
|
||||
If UBound(teikiList) < LBound(teikiList) Then Exit Sub
|
||||
|
||||
' Build dropdown list
|
||||
Dim dropdownList As String: dropdownList = ""
|
||||
Dim i As Long
|
||||
For i = LBound(teikiList) To UBound(teikiList)
|
||||
Dim val As String: val = CStr(teikiList(i))
|
||||
If val <> "" Then
|
||||
If dropdownList = "" Then
|
||||
dropdownList = val
|
||||
Else
|
||||
dropdownList = dropdownList & "," & val
|
||||
End If
|
||||
End If
|
||||
Next i
|
||||
|
||||
If dropdownList <> "" Then
|
||||
With Me.Range(targetCell & rowNum).Validation
|
||||
.Delete
|
||||
.Add Type:=xlValidateList, Formula1:=dropdownList
|
||||
.IgnoreBlank = True
|
||||
.InCellDropdown = True
|
||||
End With
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Reference in New Issue
Block a user