refactor
This commit is contained in:
updsv7
167
src/sh/tuk/sheet/M1.cls
Normal file
167
src/sh/tuk/sheet/M1.cls
Normal file
@@ -0,0 +1,167 @@
|
||||
' ============================================================
|
||||
' Module Name: Master_Kukan
|
||||
' Module Desc: M1 Kukan master data management (import/export/validate)
|
||||
' Module Methods:
|
||||
' - CreateEnumDropdown
|
||||
' - Worksheet_Change
|
||||
' - Validate
|
||||
' ============================================================
|
||||
|
||||
' Create dropdown for L column
|
||||
Private Sub CreateEnumDropdown(ByVal rowNum As Long)
|
||||
Dim tokubetuList As Object: Set tokubetuList = GetCache("tokubetuList")
|
||||
' Build dropdown list from tokubetuList
|
||||
Dim dropdownList As String
|
||||
dropdownList = ""
|
||||
|
||||
Dim key As Variant
|
||||
For Each key In tokubetuList.Keys
|
||||
If dropdownList = "" Then
|
||||
dropdownList = key
|
||||
Else
|
||||
dropdownList = dropdownList & "," & key
|
||||
End If
|
||||
Next key
|
||||
|
||||
With Me.Range("L" & rowNum).Validation
|
||||
.Delete
|
||||
.Add Type:=xlValidateList, Formula1:=dropdownList
|
||||
.IgnoreBlank = True
|
||||
.InCellDropdown = True
|
||||
.InputTitle = ""
|
||||
.InputMessage = ""
|
||||
End With
|
||||
|
||||
End Sub
|
||||
|
||||
'
|
||||
Private Sub Worksheet_Change(ByVal Target As Range)
|
||||
Dim HasHeaderEdit As Boolean: HasHeaderEdit = CheckHeaderEdit(Me, Target)
|
||||
If HasHeaderEdit = True Then Exit Sub
|
||||
|
||||
' === Column C changes: Create L column dropdown ===
|
||||
If Target.Column = 3 And Target.Row >= 7 Then
|
||||
Dim cell As Range
|
||||
For Each cell In Target
|
||||
If Trim(cell.Value) = "" Then
|
||||
Me.Cells(cell.Row, 12).Validation.Delete
|
||||
Call ClearDataRow(Me, START_COL + 1, END_COL, cell.Row, ERROR_COL)
|
||||
Else
|
||||
Call CreateEnumDropdown(cell.Row)
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
|
||||
' === Column D changes: Fill E column ===
|
||||
If Target.Column = 4 And Target.Row >= 7 Then
|
||||
Dim z1Cache As Object: Set z1Cache = GetCache("Z1")
|
||||
|
||||
Dim cellD As Range
|
||||
For Each cellD In Target
|
||||
Dim dVal As String: dVal = Trim(cellD.Value)
|
||||
If dVal = "" Then
|
||||
Me.Cells(cellD.Row, 5).ClearContents
|
||||
Else
|
||||
If Not z1Cache Is Nothing And z1Cache.Exists(dVal) Then
|
||||
Dim valsD As Variant: valsD = z1Cache(dVal)
|
||||
Me.Cells(cellD.Row, 5).Value = valsD(0)
|
||||
Else
|
||||
Me.Cells(cellD.Row, 5).ClearContents
|
||||
End If
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
End Sub
|
||||
|
||||
Private Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
|
||||
|
||||
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
|
||||
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
|
||||
|
||||
Dim startCol As String: startCol = sheetConf("StartCol")
|
||||
Dim endCol As String: endCol = sheetConf("EndCol")
|
||||
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
|
||||
|
||||
Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
|
||||
clearRange.Interior.Color = vbWhite
|
||||
|
||||
' Check column required
|
||||
Dim colLetter As Variant
|
||||
For Each colLetter In Array("C", "D", "E", "F", "G", "I", "L")
|
||||
If Trim(ws.Range(colLetter & rowNum).Value) = "" Then
|
||||
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E002", colLetter & rowNum)
|
||||
ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
Exit Sub
|
||||
End If
|
||||
Next colLetter
|
||||
|
||||
' Check column numeric
|
||||
For Each colLetter In Array("H", "I", "J", "N")
|
||||
Dim val As String: val = Trim(ws.Range(colLetter & rowNum).Value)
|
||||
If val <> "" And Not IsNumeric(val) Then
|
||||
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E011", colLetter & rowNum)
|
||||
ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
Exit Sub
|
||||
End If
|
||||
Next colLetter
|
||||
|
||||
' Check C column repeat
|
||||
Dim cValue As String: cValue = Trim(ws.Range("C" & rowNum).Value)
|
||||
Dim foundCell As Range
|
||||
Set foundCell = ws.Range("C7:C" & lastDataRow).Find(What:=cValue, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
|
||||
If Not foundCell Is Nothing Then
|
||||
If foundCell.Row <> rowNum Then
|
||||
ws.Cells(rowNum, errorCol).Value = "C column value is duplicated"
|
||||
ws.Range("C" & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
|
||||
' Check D and E column in the cache
|
||||
Dim z1Cache As Object: Set z1Cache = GetCache("Z1")
|
||||
|
||||
Dim dValue As String: dValue = Trim(ws.Range("D" & rowNum).Value)
|
||||
Dim eValue As String: eValue = Trim(ws.Range("E" & rowNum).Value)
|
||||
|
||||
If Not z1Cache.Exists(dValue) Then
|
||||
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E004", "D" & rowNum)
|
||||
ws.Range("D" & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
Exit Sub
|
||||
Else
|
||||
Dim valueArray As Variant
|
||||
valueArray = z1Cache(dValue)
|
||||
If Not IsArray(valueArray) Or UBound(valueArray) < 0 Then
|
||||
ws.Cells(rowNum, errorCol).Value = "Invalid reference data for D column."
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
Dim expectedEValue As String
|
||||
expectedEValue = Trim(CStr(valueArray(0)))
|
||||
|
||||
If eValue <> expectedEValue Then
|
||||
ws.Cells(rowNum, errorCol).Value = "E column does not match reference data."
|
||||
ws.Range("E" & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
Exit Sub
|
||||
End If
|
||||
End If
|
||||
|
||||
' Check L column in the tokubetuList
|
||||
Dim tokubetuList As Object: Set tokubetuList = GetCache("tokubetuList")
|
||||
Dim lValue As String: lValue = Trim(ws.Range("L" & rowNum).Value)
|
||||
If Not tokubetuList.Exists(lValue) Then
|
||||
ws.Cells(rowNum, errorCol).Value = "L column does not exist."
|
||||
ws.Range("L" & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' Check if M2 uses this M1 kukan code
|
||||
Dim m2Cache As Object: Set m2Cache = GetCache("M2")
|
||||
If Not m2Cache.Exists(cValue) Then
|
||||
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("W001", cValue)
|
||||
ws.Range("C" & rowNum).Interior.Color = RGB(255, 128, 0)
|
||||
Exit Sub
|
||||
End If
|
||||
|
||||
' Validation passed - clear error
|
||||
ws.Cells(rowNum, errorCol).ClearContents
|
||||
End Sub
|
||||
Reference in New Issue
Block a user