M2 update

This commit is contained in:
simple321vip
2026-04-22 00:00:00 +08:00
parent 5bb92f89c4
commit 1056cb1d1b
4 changed files with 166 additions and 21 deletions

View File

@@ -8,8 +8,23 @@
' - Validate
' ============================================================
Private Sub Worksheet_Change(ByVal Target As Range)
Dim watchArea As Range
With Me
Set watchArea = Union( _
.Columns("C"), _
.Columns("I:R") _
)
End With
Dim intersectRng As Range: Set intersectRng = Application.Intersect(Target, watchArea)
If intersectRng Is Nothing Then Exit Sub
If Target.Row < 7 Then Exit Sub
Application.EnableEvents = False
On Error GoTo Finally
' === Fill D, E when C column changes ===
If Target.Column = 3 And Target.Row >= 7 Then
If Target.Column = 3 Then
Dim cell As Range
For Each cell In Target
If Trim(cell.Value) = "" Then
@@ -21,25 +36,55 @@ Private Sub Worksheet_Change(ByVal Target As Range)
End If
' === Create J dropdown when I column changes ===
If Target.Column = 9 And Target.Row >= 7 Then
If Target.Column = 9 Then
Dim cellI As Range
For Each cellI In Target
' clear
Me.Range(Me.Cells(cellI.Row, 10), Me.Cells(cellI.Row, 18)).ClearContents
Me.Cells(cellI.Row, 11).Validation.Delete
Me.Range(Me.Cells(cellI.Row, 10), Me.Cells(cellI.Row, 18)).Interior.Color = vbWhite
Call CreateJDropdown(cellI.Row)
Next
End If
' === Fill K column when J column changes ===
If Target.Column = 10 And Target.Row >= 7 Then
If Target.Column = 10 Then
Dim cellJ As Range
For Each cellJ In Target
Call FillKFromJ(cellJ.Row)
Next
End If
Dim kenshuKbn As String: kenshuKbn = Trim(Me.Range("I" & Target.Row).value)
Dim restrictedCols As Range
If kenshuKbn = "1" Then
Set restrictedCols = Union(Me.Columns("K"), Me.Columns("O"), Me.Columns("P"), Me.Columns("Q"), Me.Columns("R"))
If Not Intersect(Target, restrictedCols) Is Nothing Then
Application.EnableEvents = False
MsgBox "can not be input", vbExclamation
Application.Undo
Application.EnableEvents = True
Exit Sub
End If
Else
Set restrictedCols = Me.Range("K:R") '
If Not Intersect(Target, restrictedCols) Is Nothing Then
Application.EnableEvents = False
MsgBox "can not be input", vbExclamation
Application.Undo
Application.EnableEvents = True
Exit Sub
End If
End If
Finally:
Application.EnableEvents = True '
End Sub
Private Sub FillKFromJ(ByVal rowNum As Long)
Dim iValue As String: iValue = Trim(Me.Range("I" & rowNum).Value)
Dim jValue As String: jValue = Trim(Me.Range("J" & rowNum).Value)
Dim code As String: code = GetCode(jValue)
If jValue = "" Then
Me.Range("K" & rowNum).ClearContents
@@ -62,13 +107,29 @@ Private Sub FillKFromJ(ByVal rowNum As Long)
If cache Is Nothing Then Exit Sub
' Check if J value exists in cache
If cache.Exists(jValue) Then
Dim cacheVal As Variant: cacheVal = cache(jValue)
' K column = value (4)
If cache.Exists(code) Then
Dim cacheVal As Variant: cacheVal = cache(code)
Me.Range("J" & rowNum).Value = Trim(code)
Me.Range("K" & rowNum).Value = Trim(cacheVal(0))
End If
' TODO: Add other settings for I=2 and I=3
Select Case iValue
Case "1"
Exit Sub
Case "2"
Me.Range("L" & rowNum).Value = Trim(cacheVal(2))
Me.Range("M" & rowNum).Value = Trim(cacheVal(3))
Me.Range("N" & rowNum).Value = Trim(cacheVal(4))
Me.Range("O" & rowNum).Value = Trim(cacheVal(5))
Me.Range("P" & rowNum).Value = Trim(cacheVal(6))
Me.Range("Q" & rowNum).Value = Trim(cacheVal(7))
Case "3"
Me.Range("L" & rowNum).Value = Trim(cacheVal(1))
Me.Range("M" & rowNum).Value = Trim(cacheVal(2))
Case Else
Exit Sub
End Select
End Sub
@@ -85,10 +146,17 @@ Private Sub CreateJDropdown(ByVal rowNum As Long)
Select Case iValue
Case "1"
Set cache = GetT1Cache()
Me.Range("O" & rowNum).Interior.Color = RGB(192, 192, 192)
Me.Range("P" & rowNum).Interior.Color = RGB(192, 192, 192)
Me.Range("Q" & rowNum).Interior.Color = RGB(192, 192, 192)
Case "2"
Set cache = GetT2Cache()
Case "3"
Set cache = GetT3Cache()
Me.Range("N" & rowNum).Interior.Color = RGB(192, 192, 192)
Me.Range("O" & rowNum).Interior.Color = RGB(192, 192, 192)
Me.Range("P" & rowNum).Interior.Color = RGB(192, 192, 192)
Me.Range("Q" & rowNum).Interior.Color = RGB(192, 192, 192)
Case Else
Exit Sub
End Select
@@ -99,10 +167,11 @@ Private Sub CreateJDropdown(ByVal rowNum As Long)
Dim dropdownList As String: dropdownList = ""
Dim key As Variant
For Each key In cache.Keys
Dim displayText As String: displayText = MakeSelect(key, cache(key)(0))
If dropdownList = "" Then
dropdownList = key
dropdownList = displayText
Else
dropdownList = dropdownList & "," & key
dropdownList = dropdownList & "," & displayText
End If
Next key
@@ -187,7 +256,7 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
' Check column required
Dim colLetter As Variant
For Each colLetter In Array("I", "J", "K")
For Each colLetter In Array("I", "J", "K", "L", "M")
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)
@@ -216,10 +285,85 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
Exit Sub
End If
' check Duplicate
Dim i As Long
' Check J column in the T1, T2, T3
Dim code As String: code = Trim(ws.Range("J" & rowNum).Value)
Dim name As String: name = Trim(ws.Range("K" & rowNum).Value)
Dim valueL As String: valueL = Trim(ws.Range("L" & rowNum).Value)
Dim valueM As String: valueM = Trim(ws.Range("M" & rowNum).Value)
Dim valueN As String: valueN = Trim(ws.Range("N" & rowNum).Value)
Dim valueO As String: valueO = Trim(ws.Range("O" & rowNum).Value)
Dim valueP As String: valueP = Trim(ws.Range("P" & rowNum).Value)
Dim valueQ As String: valueQ = Trim(ws.Range("Q" & rowNum).Value)
Dim cache As Object
Dim requiredCols As Variant
Dim equaledCols As Variant
Dim emptyCols As Variant
If kenshuKbn = "1" Then
Set cache = GetT1Cache()
' must input
equaledCols = Array("K")
requiredCols = Array("N")
emptyCols = Array("O", "P", "Q", "R")
End If
If kenshuKbn = "2" Then
Set cache = GetT2Cache()
' must input
equaledCols = Array("K", "L", "M", "N", "O", "P", "Q")
requiredCols = Array("N", "O", "P", "Q")
emptyCols = Array("R")
End If
If kenshuKbn = "3" Then
Set cache = GetT3Cache()
' must input
equaledCols = Array("K", "L", "M")
requiredCols = Array()
emptyCols = Array("N", "O", "P", "Q", "R")
End If
' code not exist check
If Not cache.Exists(code) Then
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E004", "J" & rowNum)
ws.Range("J" & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
' Dim equaledColIndex As Long
' For equaledColIndex = 0 To
' Dim equaledCol As Variant
' For Each equaledCol In equaledCols
' Dim equalValue As String: equalValue = Trim(ws.Range(equaledCol & rowNum).Value)
' cache
' If cache(code)(0) <> name Then
' Exit Sub
' End If
' Me.Range(equaledCol & rowNum).Validation.Delete
' Next equaledCol
Dim requiredCol As Variant
For Each requiredCol In requiredCols
Dim requiredValue As String: requiredValue = Trim(ws.Range(requiredCol & rowNum).Value)
If requiredValue = "" Then
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E002", requiredCol & rowNum)
ws.Range(requiredCol & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Next requiredCol
Dim emptyCol As Variant
For Each emptyCol In emptyCols
Dim emptyValue As String: emptyValue = Trim(ws.Range(emptyCol & rowNum).Value)
If emptyValue <> "" Then
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E005", emptyCol & rowNum)
ws.Range(emptyCol & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Next emptyCol
' check Duplicate
Dim i As Long
For i = 7 To rowNum - 1
If Trim(ws.Cells(i, "C").Value) = cValue And Trim(ws.Cells(i, "I").Value) = kenshuKbn And Trim(ws.Cells(i, "J").Value) = code Then
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E013", i, checkValue)
@@ -238,4 +382,5 @@ Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
End Sub
Sub ImportCSVAndTriggerChange(ws As Worksheet)
' TODO
End Sub