M2 update
This commit is contained in:
171
src/sheet/M2.cls
171
src/sheet/M2.cls
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user