20260515指摘対応8
This commit is contained in:
@@ -137,9 +137,9 @@ Private Sub DO_CSV_Import(ws As Excel.Worksheet)
|
|||||||
End If
|
End If
|
||||||
|
|
||||||
' === Step 4: Clear all data rows before import ===
|
' === Step 4: Clear all data rows before import ===
|
||||||
|
Call ClearDataRows(ws)
|
||||||
Application.ScreenUpdating = False
|
Application.ScreenUpdating = False
|
||||||
Application.EnableEvents = False
|
Application.EnableEvents = False
|
||||||
Call ClearDataRows(ws)
|
|
||||||
|
|
||||||
' === Step 5: Write CSV data to worksheet ===
|
' === Step 5: Write CSV data to worksheet ===
|
||||||
Dim colLetters As Variant: colLetters = cfg("HeaderColumns")
|
Dim colLetters As Variant: colLetters = cfg("HeaderColumns")
|
||||||
@@ -194,11 +194,16 @@ Private Sub Do_Validation(ws As Excel.Worksheet)
|
|||||||
Application.Run "M1.ValidateWarn", ws, lastDataRow
|
Application.Run "M1.ValidateWarn", ws, lastDataRow
|
||||||
End If
|
End If
|
||||||
|
|
||||||
Do_Fit ws
|
GoTo FinallyExit
|
||||||
Exit Sub
|
Exit Sub
|
||||||
|
|
||||||
ErrorHandler:
|
ErrorHandler:
|
||||||
HandleError "Do_Validation"
|
HandleError "Do_Validation"
|
||||||
|
GoTo FinallyExit
|
||||||
|
|
||||||
|
FinallyExit:
|
||||||
|
Do_Fit ws
|
||||||
|
ClearFormatsBelowLastDataRow ws
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
' ============================================================
|
' ============================================================
|
||||||
@@ -258,9 +263,11 @@ Private Sub DO_CSV_Export(ws As Excel.Worksheet)
|
|||||||
|
|
||||||
Dim colLetters As Variant: colLetters = sheetConf("HeaderColumns")
|
Dim colLetters As Variant: colLetters = sheetConf("HeaderColumns")
|
||||||
Dim r As Long
|
Dim r As Long
|
||||||
|
Dim colIndex As Long
|
||||||
For r = startRow To lastDataRow
|
For r = startRow To lastDataRow
|
||||||
For colIdx = 0 To expectedColumnCount - 1
|
For colIdx = 0 To expectedColumnCount - 1
|
||||||
outputArr(dataRow, colIdx + 1) = CleanCSVField(ws.Cells(r, Columns(colLetters(colIdx))).Column).Value)
|
colIndex = Columns(colLetters(colIdx)).Column
|
||||||
|
outputArr(dataRow, colIdx + 1) = CleanCSVField(ws.Cells(r, colIndex).Value)
|
||||||
Next colIdx
|
Next colIdx
|
||||||
dataRow = dataRow + 1
|
dataRow = dataRow + 1
|
||||||
Next r
|
Next r
|
||||||
|
|||||||
@@ -45,7 +45,7 @@ ErrorHandler:
|
|||||||
Err.Raise ERR_CONFIG_INVALID, "GetCSVHeader", "Invalid column letter in HeaderColumns: '" & colLetters(i) & "'"
|
Err.Raise ERR_CONFIG_INVALID, "GetCSVHeader", "Invalid column letter in HeaderColumns: '" & colLetters(i) & "'"
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
'
|
' Clean CSV field: add quote prefix for formula-like values
|
||||||
Function CleanCSVField(ByVal inputStr As String) As String
|
Function CleanCSVField(ByVal inputStr As String) As String
|
||||||
Dim s As String
|
Dim s As String
|
||||||
s = Trim(inputStr)
|
s = Trim(inputStr)
|
||||||
@@ -62,10 +62,12 @@ Function CleanCSVField(ByVal inputStr As String) As String
|
|||||||
CleanCSVField = s
|
CleanCSVField = s
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
|
' Get last data row in specified column
|
||||||
Function GetLastDataRow(ByVal ws As Worksheet, ByVal columnNum As Long) As Long
|
Function GetLastDataRow(ByVal ws As Worksheet, ByVal columnNum As Long) As Long
|
||||||
GetLastDataRow = ws.Cells(ws.Rows.Count, columnNum).End(xlUp).Row
|
GetLastDataRow = ws.Cells(ws.Rows.Count, columnNum).End(xlUp).Row
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
|
' Check if array contains value
|
||||||
Function Contains(ByVal arr As Variant, ByVal value As String) As Boolean
|
Function Contains(ByVal arr As Variant, ByVal value As String) As Boolean
|
||||||
Dim i As Long
|
Dim i As Long
|
||||||
For i = 0 To UBound(arr)
|
For i = 0 To UBound(arr)
|
||||||
@@ -184,7 +186,7 @@ ErrHandler:
|
|||||||
Err.Raise Err.Number, Err.Source, Err.Description
|
Err.Raise Err.Number, Err.Source, Err.Description
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
' obtain
|
' Get last data row in specified column
|
||||||
Function GetLastDataRowInRange(ws As Worksheet) As Long
|
Function GetLastDataRowInRange(ws As Worksheet) As Long
|
||||||
|
|
||||||
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
|
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
|
||||||
@@ -218,6 +220,7 @@ InvalidColumn:
|
|||||||
Err.Raise ERR_CONFIG_INVALID, "GetLastDataRowInRange", "Invalid column letter for sheet: " & ws.CodeName
|
Err.Raise ERR_CONFIG_INVALID, "GetLastDataRowInRange", "Invalid column letter for sheet: " & ws.CodeName
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
|
'Clear single row data and format
|
||||||
Function ClearDataRow(ByVal ws As Worksheet, ByVal startCol As Long, ByVal endCol As Long, ByVal rowRow As Long, Optional ByVal errorCol As Long = 2)
|
Function ClearDataRow(ByVal ws As Worksheet, ByVal startCol As Long, ByVal endCol As Long, ByVal rowRow As Long, Optional ByVal errorCol As Long = 2)
|
||||||
If rowRow >= 7 Then
|
If rowRow >= 7 Then
|
||||||
Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowRow, startCol), ws.Cells(rowRow, endCol))
|
Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowRow, startCol), ws.Cells(rowRow, endCol))
|
||||||
@@ -227,8 +230,9 @@ Function ClearDataRow(ByVal ws As Worksheet, ByVal startCol As Long, ByVal endCo
|
|||||||
End If
|
End If
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
|
'Clear all data rows from startRow to lastDataRow
|
||||||
Sub ClearDataRows(ByVal ws As Worksheet)
|
Sub ClearDataRows(ByVal ws As Worksheet)
|
||||||
'
|
' Clear data and format from startRow to lastDataRow
|
||||||
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
|
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
|
||||||
'
|
'
|
||||||
If Not sheetConfDict.Exists(ws.CodeName) Then
|
If Not sheetConfDict.Exists(ws.CodeName) Then
|
||||||
@@ -241,10 +245,9 @@ Sub ClearDataRows(ByVal ws As Worksheet)
|
|||||||
Dim startCol As String: startCol = sheetConf("StartCol")
|
Dim startCol As String: startCol = sheetConf("StartCol")
|
||||||
Dim endCol As String: endCol = sheetConf("EndCol")
|
Dim endCol As String: endCol = sheetConf("EndCol")
|
||||||
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
|
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
|
||||||
'
|
|
||||||
Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(ws)
|
|
||||||
|
|
||||||
'
|
Application.EnableEvents = False
|
||||||
|
Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(ws)
|
||||||
If lastDataRow >= startRow Then
|
If lastDataRow >= startRow Then
|
||||||
Dim clearRange As Range
|
Dim clearRange As Range
|
||||||
Set clearRange = ws.Range(ws.Cells(startRow, ws.Range(startCol & "1").Column), ws.Cells(lastDataRow, ws.Range(endCol & "1").Column))
|
Set clearRange = ws.Range(ws.Cells(startRow, ws.Range(startCol & "1").Column), ws.Cells(lastDataRow, ws.Range(endCol & "1").Column))
|
||||||
@@ -258,9 +261,52 @@ Sub ClearDataRows(ByVal ws As Worksheet)
|
|||||||
clearErrorRange.Interior.Color = vbWhite
|
clearErrorRange.Interior.Color = vbWhite
|
||||||
End If
|
End If
|
||||||
End If
|
End If
|
||||||
|
|
||||||
|
' Clear formats below lastDataRow (including dropdowns)
|
||||||
|
Application.EnableEvents = True
|
||||||
|
Call ClearFormatsBelowLastDataRow(ws)
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
' Format: code:value (no space around colon)
|
'Clear formats below lastDataRow
|
||||||
|
Sub ClearFormatsBelowLastDataRow(ws As Worksheet)
|
||||||
|
On Error GoTo ErrorHandler
|
||||||
|
Dim lastRow As Long: lastRow = GetLastDataRowInRange(ws)
|
||||||
|
|
||||||
|
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
|
||||||
|
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
|
||||||
|
|
||||||
|
Dim startCol As Long, endCol As Long
|
||||||
|
startCol = ws.Range(sheetConf("ErrorCol") & "1").Column
|
||||||
|
endCol = ws.Range(sheetConf("EndCol") & "1").Column
|
||||||
|
|
||||||
|
If lastRow >= ws.Rows.Count Then Exit Sub
|
||||||
|
|
||||||
|
Dim clearRange As Range
|
||||||
|
Set clearRange = ws.Range( _
|
||||||
|
ws.Cells(lastRow + 1, startCol), _
|
||||||
|
ws.Cells(ws.Rows.Count, endCol) _
|
||||||
|
)
|
||||||
|
|
||||||
|
Application.EnableEvents = False
|
||||||
|
clearRange.ClearContents
|
||||||
|
clearRange.Interior.Color = vbWhite
|
||||||
|
clearRange.Validation.Delete
|
||||||
|
Application.EnableEvents = True
|
||||||
|
|
||||||
|
ErrorHandler:
|
||||||
|
Application.EnableEvents = True
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
' Check if text starts with prefix
|
||||||
|
Function StartsWith(text As String, prefix As String) As Boolean
|
||||||
|
If Len(text) < Len(prefix) Then
|
||||||
|
StartsWith = False
|
||||||
|
Else
|
||||||
|
StartsWith = (Left(text, Len(prefix)) = prefix)
|
||||||
|
End If
|
||||||
|
End Function
|
||||||
|
|
||||||
|
' Make select format: code:value
|
||||||
Function MakeSelect(ByVal code As String, ByVal value As String) As String
|
Function MakeSelect(ByVal code As String, ByVal value As String) As String
|
||||||
MakeSelect = Trim(code) & ":" & Trim(value)
|
MakeSelect = Trim(code) & ":" & Trim(value)
|
||||||
End Function
|
End Function
|
||||||
@@ -316,16 +362,16 @@ Public Function FormatDateInput(ByVal inputStr As String) As String
|
|||||||
End If
|
End If
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
|
'Check header edit protection
|
||||||
Function CheckHeaderEdit(ByVal ws As Worksheet, ByVal Target As Range) As Boolean
|
Function CheckHeaderEdit(ByVal ws As Worksheet, ByVal Target As Range) As Boolean
|
||||||
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
|
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
|
||||||
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
|
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
|
||||||
Dim headerRow As Long: headerRow = sheetConf("HeaderRow")
|
|
||||||
Dim filterRow As Long: filterRow = sheetConf("FilterRow")
|
Dim filterRow As Long: filterRow = sheetConf("FilterRow")
|
||||||
|
|
||||||
' Check header row (headerRow) cannot be edited
|
' Check header row (headerRow) cannot be edited
|
||||||
Dim r As Long
|
Dim r As Long
|
||||||
For r = Target.Row To Target.Row + Target.Rows.Count - 1
|
For r = Target.Row To Target.Row + Target.Rows.Count - 1
|
||||||
If r = headerRow Or r = filterRow Then
|
If r = 1 Or r = filterRow Then
|
||||||
Application.EnableEvents = False
|
Application.EnableEvents = False
|
||||||
MsgBox "Header or type definition row cannot be edited.", vbExclamation
|
MsgBox "Header or type definition row cannot be edited.", vbExclamation
|
||||||
Application.Undo
|
Application.Undo
|
||||||
@@ -355,6 +401,7 @@ Function CheckHeaderEdit(ByVal ws As Worksheet, ByVal Target As Range) As Boolea
|
|||||||
CheckHeaderEdit = False
|
CheckHeaderEdit = False
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
|
'Get error message by code
|
||||||
Function GetErrorMsg(ByVal errorCode As String, Optional ByVal param0 As String = "", Optional ByVal param1 As String = "") As String
|
Function GetErrorMsg(ByVal errorCode As String, Optional ByVal param0 As String = "", Optional ByVal param1 As String = "") As String
|
||||||
Dim errorList As Object: Set errorList = GetCache("errorList")
|
Dim errorList As Object: Set errorList = GetCache("errorList")
|
||||||
Dim errorMessage As String
|
Dim errorMessage As String
|
||||||
@@ -366,10 +413,12 @@ Function GetErrorMsg(ByVal errorCode As String, Optional ByVal param0 As String
|
|||||||
GetErrorMsg = errorMessage
|
GetErrorMsg = errorMessage
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
|
'Convert column number to letter
|
||||||
Function ColLetter(colNum As Long) As String
|
Function ColLetter(colNum As Long) As String
|
||||||
ColLetter = Split(Cells(1, colNum).Address, "$")(1)
|
ColLetter = Split(Cells(1, colNum).Address, "$")(1)
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
|
'Check required field is not empty
|
||||||
Function CheckRequired(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal errorCol As String) As Boolean
|
Function CheckRequired(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal errorCol As String) As Boolean
|
||||||
Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
|
Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
|
||||||
If checkValue = "" Then
|
If checkValue = "" Then
|
||||||
@@ -382,6 +431,7 @@ Function CheckRequired(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum
|
|||||||
CheckRequired = True
|
CheckRequired = True
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
|
'Check character length
|
||||||
Function CheckChar(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal charLength As Long, ByVal errorCol As String)
|
Function CheckChar(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal charLength As Long, ByVal errorCol As String)
|
||||||
Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
|
Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
|
||||||
If Len(checkValue) <> charLength Then
|
If Len(checkValue) <> charLength Then
|
||||||
@@ -394,6 +444,7 @@ Function CheckChar(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As
|
|||||||
CheckChar = True
|
CheckChar = True
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
|
'Check alphanumeric characters
|
||||||
Function CheckAlphanumeric(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal charLength As Long, ByVal errorCol As String)
|
Function CheckAlphanumeric(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal charLength As Long, ByVal errorCol As String)
|
||||||
Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
|
Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
|
||||||
Dim letter As String: letter = ColLetter(colNum)
|
Dim letter As String: letter = ColLetter(colNum)
|
||||||
@@ -412,6 +463,7 @@ Function CheckAlphanumeric(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal co
|
|||||||
CheckAlphanumeric = True
|
CheckAlphanumeric = True
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
|
'Check varchar length overflow
|
||||||
Function CheckVarcharOver(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal varcharLength As Long, ByVal errorCol As String)
|
Function CheckVarcharOver(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal varcharLength As Long, ByVal errorCol As String)
|
||||||
Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
|
Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
|
||||||
If Len(checkValue) > varcharLength Then
|
If Len(checkValue) > varcharLength Then
|
||||||
@@ -424,6 +476,7 @@ Function CheckVarcharOver(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal col
|
|||||||
CheckVarcharOver = True
|
CheckVarcharOver = True
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
|
'Check number length overflow
|
||||||
Function CheckNumberOver(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal numberLength As Long, ByVal errorCol As String)
|
Function CheckNumberOver(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal numberLength As Long, ByVal errorCol As String)
|
||||||
Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
|
Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
|
||||||
If Len(checkValue) > numberLength Then
|
If Len(checkValue) > numberLength Then
|
||||||
@@ -436,6 +489,7 @@ Function CheckNumberOver(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colN
|
|||||||
CheckNumberOver = True
|
CheckNumberOver = True
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
|
'Check value is 0 or 1
|
||||||
Function Check01(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal errorCol As String)
|
Function Check01(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal errorCol As String)
|
||||||
Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
|
Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
|
||||||
Dim letter As String: letter = ColLetter(colNum)
|
Dim letter As String: letter = ColLetter(colNum)
|
||||||
@@ -456,6 +510,7 @@ Function Check01(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Lo
|
|||||||
Check01 = True
|
Check01 = True
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
|
'Check value is 1 or 2
|
||||||
Function Check12(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal errorCol As String)
|
Function Check12(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal errorCol As String)
|
||||||
Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
|
Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
|
||||||
Dim letter As String: letter = ColLetter(colNum)
|
Dim letter As String: letter = ColLetter(colNum)
|
||||||
@@ -476,6 +531,7 @@ Function Check12(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Lo
|
|||||||
Check12 = True
|
Check12 = True
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
|
'Check duplicate value in column
|
||||||
Function CheckDuplicate(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal errorCol As String) As Boolean
|
Function CheckDuplicate(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal errorCol As String) As Boolean
|
||||||
Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
|
Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
|
||||||
Dim letter As String: letter = ColLetter(colNum)
|
Dim letter As String: letter = ColLetter(colNum)
|
||||||
@@ -493,6 +549,7 @@ Function CheckDuplicate(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNu
|
|||||||
CheckDuplicate = True
|
CheckDuplicate = True
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
|
'Check numeric value
|
||||||
Function CheckNumber(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal errorCol As String) As Boolean
|
Function CheckNumber(ByVal ws As Worksheet, ByVal rowNum As Long, ByVal colNum As Long, ByVal errorCol As String) As Boolean
|
||||||
Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
|
Dim checkValue As String: checkValue = Trim(ws.Cells(rowNum, colNum).Value)
|
||||||
Dim letter As String: letter = ColLetter(colNum)
|
Dim letter As String: letter = ColLetter(colNum)
|
||||||
|
|||||||
@@ -419,7 +419,7 @@ Private Sub RefreshSheetDict()
|
|||||||
sheetConf("AlwaysQuote") = True
|
sheetConf("AlwaysQuote") = True
|
||||||
sheetConf("FilterRow") = 6
|
sheetConf("FilterRow") = 6
|
||||||
sheetConf("KeyCol") = 3
|
sheetConf("KeyCol") = 3
|
||||||
sheetConf("ValueCols") = Array(4, 6, 8, 9, 10, 11, 12, 13)
|
sheetConf("ValueCols") = Array(4, 8, 9, 10, 11, 12, 13)
|
||||||
Set sheetConfDict("T2") = sheetConf
|
Set sheetConfDict("T2") = sheetConf
|
||||||
Debug.Print "RefreshSheetDict T2 ok."
|
Debug.Print "RefreshSheetDict T2 ok."
|
||||||
|
|
||||||
|
|||||||
@@ -59,11 +59,13 @@ Private Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
|
|||||||
Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
|
Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
|
||||||
clearRange.Interior.Color = vbWhite
|
clearRange.Interior.Color = vbWhite
|
||||||
|
|
||||||
|
Dim errorCell As Range: Set errorCell = ws.Cells(rowNum, errorCol)
|
||||||
|
|
||||||
' Check column required
|
' Check column required
|
||||||
Dim colLetter As Variant
|
Dim colLetter As Variant
|
||||||
For Each colLetter In Array("C", "D", "E", "F", "G", "I", "L")
|
For Each colLetter In Array("C", "D", "E", "F", "G", "I", "L")
|
||||||
If Trim(ws.Range(colLetter & rowNum).Value) = "" Then
|
If Trim(ws.Range(colLetter & rowNum).Value) = "" Then
|
||||||
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E002", colLetter & rowNum)
|
errorCell.Value = GetErrorMsg("E002", colLetter & rowNum)
|
||||||
ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0)
|
ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||||
Exit Sub
|
Exit Sub
|
||||||
End If
|
End If
|
||||||
@@ -73,7 +75,7 @@ Private Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
|
|||||||
For Each colLetter In Array("H", "I", "J", "N")
|
For Each colLetter In Array("H", "I", "J", "N")
|
||||||
Dim val As String: val = Trim(ws.Range(colLetter & rowNum).Value)
|
Dim val As String: val = Trim(ws.Range(colLetter & rowNum).Value)
|
||||||
If val <> "" And Not IsNumeric(val) Then
|
If val <> "" And Not IsNumeric(val) Then
|
||||||
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E011", colLetter & rowNum)
|
errorCell.Value = GetErrorMsg("E011", colLetter & rowNum)
|
||||||
ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0)
|
ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||||
Exit Sub
|
Exit Sub
|
||||||
End If
|
End If
|
||||||
@@ -85,7 +87,7 @@ Private Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
|
|||||||
Set foundCell = ws.Range("C7:C" & lastDataRow).Find(What:=cValue, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
|
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 Not foundCell Is Nothing Then
|
||||||
If foundCell.Row <> rowNum Then
|
If foundCell.Row <> rowNum Then
|
||||||
ws.Cells(rowNum, errorCol).Value = "C column value is duplicated"
|
errorCell.Value = "C column value is duplicated"
|
||||||
ws.Range("C" & rowNum).Interior.Color = RGB(255, 0, 0)
|
ws.Range("C" & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||||
Exit Sub
|
Exit Sub
|
||||||
End If
|
End If
|
||||||
@@ -98,14 +100,14 @@ Private Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
|
|||||||
Dim eValue As String: eValue = Trim(ws.Range("E" & rowNum).Value)
|
Dim eValue As String: eValue = Trim(ws.Range("E" & rowNum).Value)
|
||||||
|
|
||||||
If Not z1Cache.Exists(dValue) Then
|
If Not z1Cache.Exists(dValue) Then
|
||||||
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E004", "D" & rowNum)
|
errorCell.Value = GetErrorMsg("E004", "D" & rowNum)
|
||||||
ws.Range("D" & rowNum).Interior.Color = RGB(255, 0, 0)
|
ws.Range("D" & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||||
Exit Sub
|
Exit Sub
|
||||||
Else
|
Else
|
||||||
Dim valueArray As Variant
|
Dim valueArray As Variant
|
||||||
valueArray = z1Cache(dValue)
|
valueArray = z1Cache(dValue)
|
||||||
If Not IsArray(valueArray) Or UBound(valueArray) < 0 Then
|
If Not IsArray(valueArray) Or UBound(valueArray) < 0 Then
|
||||||
ws.Cells(rowNum, errorCol).Value = "Invalid reference data for D column."
|
errorCell.Value = "Invalid reference data for D column."
|
||||||
Exit Sub
|
Exit Sub
|
||||||
End If
|
End If
|
||||||
|
|
||||||
@@ -113,7 +115,7 @@ Private Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
|
|||||||
expectedEValue = Trim(CStr(valueArray(0)))
|
expectedEValue = Trim(CStr(valueArray(0)))
|
||||||
|
|
||||||
If eValue <> expectedEValue Then
|
If eValue <> expectedEValue Then
|
||||||
ws.Cells(rowNum, errorCol).Value = "E column does not match reference data."
|
errorCell.Value = "E column does not match reference data."
|
||||||
ws.Range("E" & rowNum).Interior.Color = RGB(255, 0, 0)
|
ws.Range("E" & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||||
Exit Sub
|
Exit Sub
|
||||||
End If
|
End If
|
||||||
@@ -123,13 +125,15 @@ Private Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As
|
|||||||
Dim tokubetuList As Object: Set tokubetuList = GetCache("tokubetuList")
|
Dim tokubetuList As Object: Set tokubetuList = GetCache("tokubetuList")
|
||||||
Dim lValue As String: lValue = Trim(ws.Range("L" & rowNum).Value)
|
Dim lValue As String: lValue = Trim(ws.Range("L" & rowNum).Value)
|
||||||
If Not tokubetuList.Exists(lValue) Then
|
If Not tokubetuList.Exists(lValue) Then
|
||||||
ws.Cells(rowNum, errorCol).Value = "L column does not exist."
|
errorCell.Value = "L column does not exist."
|
||||||
ws.Range("L" & rowNum).Interior.Color = RGB(255, 0, 0)
|
ws.Range("L" & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||||
Exit Sub
|
Exit Sub
|
||||||
End If
|
End If
|
||||||
|
|
||||||
' Validation passed - clear error
|
' Validation passed - clear error
|
||||||
ws.Cells(rowNum, errorCol).ClearContents
|
If Not StartsWith(errorCell.Value, "W") Then
|
||||||
|
errorCell.ClearContents
|
||||||
|
End If
|
||||||
Exit Sub
|
Exit Sub
|
||||||
|
|
||||||
ErrHandler:
|
ErrHandler:
|
||||||
@@ -150,6 +154,8 @@ Private Sub Refresh(ws As Worksheet, ByVal startRow As Long, ByVal lastDataRow A
|
|||||||
Dim valsD As Variant: valsD = z1Cache(dVal)
|
Dim valsD As Variant: valsD = z1Cache(dVal)
|
||||||
ws.Cells(r, 5).Value = valsD(0) ' Column E
|
ws.Cells(r, 5).Value = valsD(0) ' Column E
|
||||||
End If
|
End If
|
||||||
|
Call BuildTokubetuDropdown(ws, "L", r)
|
||||||
|
Call BuildRenrakuDropdown(ws, "K", r)
|
||||||
Next r
|
Next r
|
||||||
|
|
||||||
Application.EnableEvents = True
|
Application.EnableEvents = True
|
||||||
|
|||||||
@@ -53,9 +53,10 @@ Private Sub Worksheet_Change(ByVal Target As Range)
|
|||||||
End If
|
End If
|
||||||
' clear
|
' clear
|
||||||
Me.Range(Me.Cells(cellI.Row, 10), Me.Cells(cellI.Row, 18)).ClearContents
|
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
|
Me.Range(Me.Cells(cellI.Row, 10), Me.Cells(cellI.Row, 18)).Interior.Color = vbWhite
|
||||||
|
Me.Cells(cellI.Row, 10).Validation.Delete
|
||||||
Call CreateJDropdown(cellI.Row)
|
Call CreateJDropdown(cellI.Row)
|
||||||
|
Call ChangeBackColor(cellI.Row)
|
||||||
Next
|
Next
|
||||||
End If
|
End If
|
||||||
|
|
||||||
@@ -93,19 +94,201 @@ Finally:
|
|||||||
Application.EnableEvents = True '
|
Application.EnableEvents = True '
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
|
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
|
||||||
|
On Error GoTo ErrHandler
|
||||||
|
|
||||||
|
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
|
||||||
|
|
||||||
|
Dim errorCell As Range: Set errorCell = ws.Cells(rowNum, errorCol)
|
||||||
|
|
||||||
|
' Check C column in the cache
|
||||||
|
Dim m1Cache As Object: Set m1Cache = GetCache("M1")
|
||||||
|
|
||||||
|
' C column check
|
||||||
|
checkResult = CheckRequired(ws, rowNum, 3, errorCol)
|
||||||
|
If checkResult = False Then Exit Sub
|
||||||
|
|
||||||
|
Dim cValue As String: cValue = Trim(ws.Range("C" & rowNum).Value)
|
||||||
|
If Not m1Cache.Exists(cValue) Then
|
||||||
|
errorCell.Value = GetErrorMsg("E004", "C" & rowNum)
|
||||||
|
ws.Range("C" & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
' Check column required
|
||||||
|
Dim colLetter As Variant
|
||||||
|
For Each colLetter In Array("I", "J", "K", "L", "M")
|
||||||
|
If Trim(ws.Range(colLetter & rowNum).Value) = "" Then
|
||||||
|
errorCell.Value = GetErrorMsg("E002", colLetter & rowNum)
|
||||||
|
ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
Next colLetter
|
||||||
|
|
||||||
|
' Check column numeric (only if has value)
|
||||||
|
Dim numericCols As Variant: numericCols = Array("L", "M", "N", "O", "P", "Q", "R")
|
||||||
|
Dim col As Variant
|
||||||
|
For Each col In numericCols
|
||||||
|
Dim val As String: val = Trim(ws.Range(col & rowNum).Value & "")
|
||||||
|
If val <> "" And Not IsNumeric(val) Then
|
||||||
|
errorCell.Value = GetErrorMsg("E011", col & rowNum)
|
||||||
|
ws.Range(col & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
Next col
|
||||||
|
|
||||||
|
Dim kenshuKbn As String: kenshuKbn = Trim(ws.Range("I" & rowNum).Value)
|
||||||
|
|
||||||
|
Dim cache As Object
|
||||||
|
Dim requiredCols As Variant
|
||||||
|
Dim equaledCols As Variant
|
||||||
|
Dim emptyCols As Variant
|
||||||
|
If kenshuKbn = "1" Then
|
||||||
|
Set cache = GetCache("T1")
|
||||||
|
' must input
|
||||||
|
equaledCols = Array("K")
|
||||||
|
requiredCols = Array("N")
|
||||||
|
emptyCols = Array("O", "P", "Q", "R")
|
||||||
|
End If
|
||||||
|
|
||||||
|
If kenshuKbn = "2" Then
|
||||||
|
Set cache = GetCache("T2")
|
||||||
|
' 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 = GetCache("T3")
|
||||||
|
' must input
|
||||||
|
equaledCols = Array("K", "L", "M")
|
||||||
|
requiredCols = Array()
|
||||||
|
emptyCols = Array("N", "O", "P", "Q", "R")
|
||||||
|
End If
|
||||||
|
|
||||||
|
' Check J column in the T1, T2, T3
|
||||||
|
' code not exist check
|
||||||
|
Dim code As String: code = Trim(ws.Range("J" & rowNum).Value)
|
||||||
|
If Not cache.Exists(code) Then
|
||||||
|
errorCell.Value = GetErrorMsg("E004", "J" & rowNum)
|
||||||
|
ws.Range("J" & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
Dim equaledCol As Variant
|
||||||
|
Dim equaledIndex As Long
|
||||||
|
For equaledIndex = LBound(equaledCols) To UBound(equaledCols)
|
||||||
|
equaledCol = equaledCols(equaledIndex)
|
||||||
|
' M2 value
|
||||||
|
Dim equalValue As String: equalValue = Trim(ws.Range(equaledCol & rowNum).Value)
|
||||||
|
If cache(code)(equaledIndex) <> equalValue Then
|
||||||
|
errorCell.Value = GetErrorMsg("E004", equaledCol & rowNum)
|
||||||
|
ws.Range(equaledCol & rowNum).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
Next equaledIndex
|
||||||
|
|
||||||
|
Dim requiredCol As Variant
|
||||||
|
For Each requiredCol In requiredCols
|
||||||
|
Dim requiredValue As String: requiredValue = Trim(ws.Range(requiredCol & rowNum).Value)
|
||||||
|
If requiredValue = "" Then
|
||||||
|
errorCell.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
|
||||||
|
errorCell.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
|
||||||
|
errorCell.Value = GetErrorMsg("E013", i, code)
|
||||||
|
ws.Cells(rowNum, "C").Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
Next i
|
||||||
|
|
||||||
|
errorCell.ClearContents
|
||||||
|
Application.EnableEvents = False
|
||||||
|
Call ChangeBackColor(rowNum)
|
||||||
|
Application.EnableEvents = True
|
||||||
|
Exit Sub
|
||||||
|
|
||||||
|
ErrHandler:
|
||||||
|
lastErrorMsg = Err.Description
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
' obtain T1/T2/T3 cache data, and update column K
|
||||||
|
Private Sub Refresh(ws As Worksheet, ByVal startRow As Long, ByVal lastDataRow As Long)
|
||||||
|
Dim kenshuList As Object: Set kenshuList = GetCache("kenshuList")
|
||||||
|
|
||||||
|
Application.EnableEvents = False
|
||||||
|
On Error GoTo ErrorHandler
|
||||||
|
|
||||||
|
Dim r As Long
|
||||||
|
For r = startRow To lastDataRow
|
||||||
|
Dim cValue As String: cValue = Trim(ws.Cells(r, 3).Value) ' Column C
|
||||||
|
|
||||||
|
' Skip if C column is empty
|
||||||
|
If cValue = "" Then
|
||||||
|
GoTo NextRow
|
||||||
|
End If
|
||||||
|
|
||||||
|
' Reuse FillFromM1 method to fill D-H columns
|
||||||
|
Call FillFromM1(ws, r)
|
||||||
|
Call BuildKenshuDropdown(ws, "I", r)
|
||||||
|
|
||||||
|
' Reuse FillKFromJ method to fill J-K columns
|
||||||
|
Dim iValue As String: iValue = Trim(ws.Cells(r, 9).Value) ' Column I
|
||||||
|
If iValue <> "" And kenshuList.Exists(iValue) Then
|
||||||
|
Call CreateJDropdown(r)
|
||||||
|
Call ChangeBackColor(r)
|
||||||
|
Call FillKFromJ(ws, r)
|
||||||
|
End If
|
||||||
|
|
||||||
|
NextRow:
|
||||||
|
Next r
|
||||||
|
|
||||||
|
Application.EnableEvents = True
|
||||||
|
Exit Sub
|
||||||
|
|
||||||
|
ErrorHandler:
|
||||||
|
Application.EnableEvents = True
|
||||||
|
Err.Raise ERR_CACHE_NOT_FOUND, "M2.Refresh", "Failed to refresh M2: " & Err.Description
|
||||||
|
End Sub
|
||||||
|
|
||||||
Private Sub FillKFromJ(ByVal ws As Worksheet, ByVal rowNum As Long)
|
Private Sub FillKFromJ(ByVal ws As Worksheet, ByVal rowNum As Long)
|
||||||
Dim iValue As String: iValue = Trim(ws.Range("I" & rowNum).Value)
|
Dim kenshu As String: kenshu = Trim(ws.Range("I" & rowNum).Value)
|
||||||
Dim jValue As String: jValue = Trim(ws.Range("J" & rowNum).Value)
|
Dim jValue As String: jValue = Trim(ws.Range("J" & rowNum).Value)
|
||||||
Dim code As String: code = GetCode(jValue)
|
Dim code As String: code = GetCode(jValue)
|
||||||
|
|
||||||
If jValue = "" Then
|
If jValue = "" Then
|
||||||
ws.Range("K" & rowNum).ClearContents
|
ws.Range(ws.Cells(rowNum, "K"), ws.Cells(rowNum, "R")).ClearContents
|
||||||
Exit Sub
|
Exit Sub
|
||||||
End If
|
End If
|
||||||
|
|
||||||
' Get cache based on I column value
|
' Get cache based on I column value
|
||||||
Dim cache As Object
|
Dim cache As Object
|
||||||
Select Case iValue
|
Select Case kenshu
|
||||||
Case "1"
|
Case "1"
|
||||||
Set cache = GetCache("T1")
|
Set cache = GetCache("T1")
|
||||||
Case "2"
|
Case "2"
|
||||||
@@ -119,7 +302,6 @@ Private Sub FillKFromJ(ByVal ws As Worksheet, ByVal rowNum As Long)
|
|||||||
If cache Is Nothing Then Exit Sub
|
If cache Is Nothing Then Exit Sub
|
||||||
|
|
||||||
' Check if J value exists in cache
|
' Check if J value exists in cache
|
||||||
|
|
||||||
If cache.Exists(code) Then
|
If cache.Exists(code) Then
|
||||||
Dim cacheVal As Variant: cacheVal = cache(code)
|
Dim cacheVal As Variant: cacheVal = cache(code)
|
||||||
ws.Range("J" & rowNum).Value = Trim(code)
|
ws.Range("J" & rowNum).Value = Trim(code)
|
||||||
@@ -130,12 +312,12 @@ Private Sub FillKFromJ(ByVal ws As Worksheet, ByVal rowNum As Long)
|
|||||||
Case "1"
|
Case "1"
|
||||||
Exit Sub
|
Exit Sub
|
||||||
Case "2"
|
Case "2"
|
||||||
ws.Range("L" & rowNum).Value = Trim(cacheVal(2))
|
ws.Range("L" & rowNum).Value = Trim(cacheVal(1))
|
||||||
ws.Range("M" & rowNum).Value = Trim(cacheVal(3))
|
ws.Range("M" & rowNum).Value = Trim(cacheVal(2))
|
||||||
ws.Range("N" & rowNum).Value = Trim(cacheVal(4))
|
ws.Range("N" & rowNum).Value = Trim(cacheVal(3))
|
||||||
ws.Range("O" & rowNum).Value = Trim(cacheVal(5))
|
ws.Range("O" & rowNum).Value = Trim(cacheVal(4))
|
||||||
ws.Range("P" & rowNum).Value = Trim(cacheVal(6))
|
ws.Range("P" & rowNum).Value = Trim(cacheVal(5))
|
||||||
ws.Range("Q" & rowNum).Value = Trim(cacheVal(7))
|
ws.Range("Q" & rowNum).Value = Trim(cacheVal(6))
|
||||||
Case "3"
|
Case "3"
|
||||||
ws.Range("L" & rowNum).Value = Trim(cacheVal(1))
|
ws.Range("L" & rowNum).Value = Trim(cacheVal(1))
|
||||||
ws.Range("M" & rowNum).Value = Trim(cacheVal(2))
|
ws.Range("M" & rowNum).Value = Trim(cacheVal(2))
|
||||||
@@ -145,39 +327,6 @@ Private Sub FillKFromJ(ByVal ws As Worksheet, ByVal rowNum As Long)
|
|||||||
|
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
Private Sub CreateJDropdown(ByVal rowNum As Long)
|
|
||||||
Dim iValue As String: iValue = Trim(Me.Range("I" & rowNum).Value)
|
|
||||||
Dim targetCell As Range: Set targetCell = Me.Range("J" & rowNum)
|
|
||||||
|
|
||||||
' Clear existing validation
|
|
||||||
targetCell.Validation.Delete
|
|
||||||
targetCell.ClearContents
|
|
||||||
|
|
||||||
' Get cache based on I column value
|
|
||||||
Dim cache As Object
|
|
||||||
Select Case iValue
|
|
||||||
Case "1"
|
|
||||||
Set cache = GetCache("T1")
|
|
||||||
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 = GetCache("T2")
|
|
||||||
Case "3"
|
|
||||||
Set cache = GetCache("T3")
|
|
||||||
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
|
|
||||||
|
|
||||||
If cache Is Nothing Then Exit Sub
|
|
||||||
|
|
||||||
Call BuildDropdownFromCacheNamedRange(Me, "J", rowNum, "T" & iValue)
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Private Sub FillFromM1(ByVal ws As Worksheet, ByVal rowNum As Long)
|
Private Sub FillFromM1(ByVal ws As Worksheet, ByVal rowNum As Long)
|
||||||
Dim m1Cache As Object: Set m1Cache = GetCache("M1")
|
Dim m1Cache As Object: Set m1Cache = GetCache("M1")
|
||||||
Dim cValue As String: cValue = Trim(ws.Range("C" & rowNum).Value)
|
Dim cValue As String: cValue = Trim(ws.Range("C" & rowNum).Value)
|
||||||
@@ -221,197 +370,41 @@ Private Sub ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long)
|
|||||||
ws.Cells(rowNum, "S").ClearContents
|
ws.Cells(rowNum, "S").ClearContents
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
|
Private Sub CreateJDropdown(ByVal rowNum As Long)
|
||||||
On Error GoTo ErrHandler
|
Dim kenshu As String: kenshu = Trim(Me.Range("I" & rowNum).Value)
|
||||||
|
Dim targetCell As Range: Set targetCell = Me.Range("J" & rowNum)
|
||||||
|
|
||||||
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
|
' Clear existing validation
|
||||||
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
|
targetCell.Validation.Delete
|
||||||
|
If kenshu = "" Then
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
Call BuildDropdownFromCacheNamedRange(Me, "J", rowNum, "T" & kenshu)
|
||||||
|
End Sub
|
||||||
|
|
||||||
Dim startCol As String: startCol = sheetConf("StartCol")
|
' change back color by I colum kennshu
|
||||||
Dim endCol As String: endCol = sheetConf("EndCol")
|
Private Sub ChangeBackColor(ByVal rowNum As Long)
|
||||||
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
|
Dim kenshu As String: kenshu = Trim(Me.Range("I" & rowNum).Value)
|
||||||
|
If kenshu = "" Then
|
||||||
Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowNum, startCol), ws.Cells(rowNum, endCol))
|
|
||||||
clearRange.Interior.Color = vbWhite
|
|
||||||
|
|
||||||
' Check C column in the cache
|
|
||||||
Dim m1Cache As Object: Set m1Cache = GetCache("M1")
|
|
||||||
|
|
||||||
' C column check
|
|
||||||
checkResult = CheckRequired(ws, rowNum, 3, errorCol)
|
|
||||||
If checkResult = False Then Exit Sub
|
|
||||||
|
|
||||||
Dim cValue As String: cValue = Trim(ws.Range("C" & rowNum).Value)
|
|
||||||
If Not m1Cache.Exists(cValue) Then
|
|
||||||
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E004", "C" & rowNum)
|
|
||||||
ws.Range("C" & rowNum).Interior.Color = RGB(255, 0, 0)
|
|
||||||
Exit Sub
|
Exit Sub
|
||||||
End If
|
End If
|
||||||
|
|
||||||
' Check column required
|
Me.Range("R" & rowNum).Interior.Color = RGB(192, 192, 192)
|
||||||
Dim colLetter As Variant
|
' Get cache based on I column value
|
||||||
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)
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
Next colLetter
|
|
||||||
|
|
||||||
' Check column numeric (only if has value)
|
|
||||||
Dim numericCols As Variant: numericCols = Array("L", "M", "N", "O", "P", "Q", "R")
|
|
||||||
Dim col As Variant
|
|
||||||
For Each col In numericCols
|
|
||||||
Dim val As String: val = Trim(ws.Range(col & rowNum).Value & "")
|
|
||||||
If val <> "" And Not IsNumeric(val) Then
|
|
||||||
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E011", col & rowNum)
|
|
||||||
ws.Range(col & rowNum).Interior.Color = RGB(255, 0, 0)
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
Next col
|
|
||||||
|
|
||||||
' 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 cache As Object
|
||||||
Dim requiredCols As Variant
|
Select Case kenshu
|
||||||
Dim equaledCols As Variant
|
Case "1"
|
||||||
Dim emptyCols As Variant
|
Me.Range("O" & rowNum).Interior.Color = RGB(192, 192, 192)
|
||||||
If kenshuKbn = "1" Then
|
Me.Range("P" & rowNum).Interior.Color = RGB(192, 192, 192)
|
||||||
Set cache = GetCache("T1")
|
Me.Range("Q" & rowNum).Interior.Color = RGB(192, 192, 192)
|
||||||
' must input
|
Case "2"
|
||||||
equaledCols = Array("K")
|
|
||||||
requiredCols = Array("N")
|
|
||||||
emptyCols = Array("O", "P", "Q", "R")
|
|
||||||
End If
|
|
||||||
|
|
||||||
If kenshuKbn = "2" Then
|
|
||||||
Set cache = GetCache("T2")
|
|
||||||
' 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 = GetCache("T3")
|
|
||||||
' 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
|
Exit Sub
|
||||||
End If
|
Case "3"
|
||||||
|
Me.Range("N" & rowNum).Interior.Color = RGB(192, 192, 192)
|
||||||
' Dim equaledColIndex As Long
|
Me.Range("O" & rowNum).Interior.Color = RGB(192, 192, 192)
|
||||||
' For equaledColIndex = 0 To
|
Me.Range("P" & rowNum).Interior.Color = RGB(192, 192, 192)
|
||||||
|
Me.Range("Q" & rowNum).Interior.Color = RGB(192, 192, 192)
|
||||||
' Dim equaledCol As Variant
|
Case Else
|
||||||
' 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
|
Exit Sub
|
||||||
End If
|
End Select
|
||||||
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)
|
|
||||||
ws.Cells(rowNum, "C").Interior.Color = RGB(255, 0, 0)
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
If Trim(ws.Cells(i, "C").Value) = cValue And Trim(ws.Cells(i, "I").Value) = kenshuKbn And Trim(ws.Cells(i, "K").Value) = name Then
|
|
||||||
ws.Cells(rowNum, errorCol).Value = GetErrorMsg("E013", i, checkValue)
|
|
||||||
ws.Cells(rowNum, "C").Interior.Color = RGB(255, 0, 0)
|
|
||||||
Exit Sub
|
|
||||||
End If
|
|
||||||
Next i
|
|
||||||
|
|
||||||
ws.Cells(rowNum, errorCol).ClearContents
|
|
||||||
Exit Sub
|
|
||||||
|
|
||||||
ErrHandler:
|
|
||||||
lastErrorMsg = Err.Description
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
Public Sub ImportCSVAndTriggerChange(ws As Worksheet, ByVal lastDataRow As Long)
|
|
||||||
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
|
|
||||||
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
|
|
||||||
|
|
||||||
Dim startRow As Long: startRow = sheetConf("StartRow")
|
|
||||||
Dim i As Long
|
|
||||||
For i = startRow To lastDataRow
|
|
||||||
Call FillFromM1(ws, i)
|
|
||||||
Next i
|
|
||||||
End Sub
|
|
||||||
|
|
||||||
' obtain T1/T2/T3 cache data, and update column K
|
|
||||||
Private Sub Refresh(ws As Worksheet, ByVal startRow As Long, ByVal lastDataRow As Long)
|
|
||||||
Dim kenshuList As Object: Set kenshuList = GetCache("kenshuList")
|
|
||||||
|
|
||||||
Application.EnableEvents = False
|
|
||||||
On Error GoTo ErrorHandler
|
|
||||||
|
|
||||||
Dim r As Long
|
|
||||||
For r = startRow To lastDataRow
|
|
||||||
Dim cValue As String: cValue = Trim(ws.Cells(r, 3).Value) ' Column C
|
|
||||||
|
|
||||||
' Skip if C column is empty
|
|
||||||
If cValue = "" Then
|
|
||||||
GoTo NextRow
|
|
||||||
End If
|
|
||||||
|
|
||||||
' Reuse FillFromM1 method to fill D-H columns
|
|
||||||
Call FillFromM1(ws, r)
|
|
||||||
|
|
||||||
' Reuse FillKFromJ method to fill J-K columns
|
|
||||||
Dim iValue As String: iValue = Trim(ws.Cells(r, 9).Value) ' Column I
|
|
||||||
If iValue <> "" And kenshuList.Exists(iValue) Then
|
|
||||||
Call FillKFromJ(ws, r)
|
|
||||||
End If
|
|
||||||
|
|
||||||
NextRow:
|
|
||||||
Next r
|
|
||||||
|
|
||||||
Application.EnableEvents = True
|
|
||||||
Exit Sub
|
|
||||||
|
|
||||||
ErrorHandler:
|
|
||||||
Application.EnableEvents = True
|
|
||||||
Err.Raise ERR_CACHE_NOT_FOUND, "M2.Refresh", "Failed to refresh M2: " & Err.Description
|
|
||||||
End Sub
|
End Sub
|
||||||
|
|||||||
Binary file not shown.
Reference in New Issue
Block a user