267 lines
8.5 KiB
QBasic
267 lines
8.5 KiB
QBasic
' ============================================================
|
|
' Module Name: Master_M2_Kukan_detail
|
|
' Module Desc: M2 Kukan detail master data management
|
|
' Module Methods:
|
|
' - M2_Import
|
|
' - M2_Export
|
|
' - M2_validateButton_Click
|
|
' - M2_SortDataRowsByC
|
|
' - M2_ToggleAutoFilter
|
|
' - M2_Worksheet_Change
|
|
' - M2_ValidateRow
|
|
' - M2_FillValidationDropdown
|
|
' - M2_ValidateAllRows
|
|
' ============================================================
|
|
' ====== Constants ======
|
|
Const START_COL As Long = 3 ' C column
|
|
Const END_COL As Long = 18 ' R column
|
|
Const ERROR_COL As Long = 19 ' S column
|
|
Const M2_HEADER_ROW As Long = 6
|
|
|
|
Function HEADERS() As Variant
|
|
HEADERS = Array("C", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R")
|
|
End Function
|
|
|
|
' ====== Function ======
|
|
|
|
Private Sub Worksheet_Change(ByVal Target As Range)
|
|
' === Fill D, E when C column changes ===
|
|
If Target.Column = 3 And Target.Row >= 7 Then
|
|
Dim cell As Range
|
|
For Each cell In Target
|
|
If Trim(cell.Value) = "" Then
|
|
Call ClearRowData(Me, cell.Row)
|
|
Else
|
|
Call FillFromM1(cell.Row)
|
|
End If
|
|
Next
|
|
End If
|
|
End Sub
|
|
|
|
Sub FillFromM1(ByVal rowNum As Long, Optional ByVal setG As Boolean = True)
|
|
Set ws = Me
|
|
|
|
If m1Cache Is Nothing Then Call RefreshM1Cache
|
|
Dim cValue As String: cValue = Trim(ws.Range("C" & rowNum).Value)
|
|
|
|
' Fill D, E, F, G, H columns from M1 cache
|
|
' D = cache[1]: cache[2] (col 4: col 5)
|
|
' E = cache[3] (col 6)
|
|
' F = cache[4] (col 7)
|
|
' G = cache[5] (col 9)
|
|
' H = cache[6] (col 12)
|
|
|
|
' Check C column in the cache
|
|
If Not m1Cache.Exists(cValue) Then
|
|
ws.Cells(rowNum, ERROR_COL).Value = "C column does not exist in M1."
|
|
ws.Range("C" & rowNum).Interior.Color = RGB(255, 0, 0)
|
|
Exit Sub
|
|
End If
|
|
|
|
Dim cacheVal As Variant: cacheVal = m1Cache(cValue)
|
|
|
|
' D column = cache[1]: cache[2]
|
|
ws.Cells(rowNum, 4).Value = Trim(cacheVal(1)) & ": " & Trim(cacheVal(2))
|
|
' E column = cache[3]
|
|
ws.Cells(rowNum, 5).Value = Trim(cacheVal(3))
|
|
' F column = cache[4]
|
|
ws.Cells(rowNum, 6).Value = Trim(cacheVal(4))
|
|
' G column = cache[5]
|
|
ws.Cells(rowNum, 7).Value = Trim(cacheVal(5))
|
|
' H column = cache[6]
|
|
ws.Cells(rowNum, 8).Value = Trim(cacheVal(6))
|
|
End Sub
|
|
|
|
Sub ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long)
|
|
' Clear from D column onwards
|
|
ws.Range(ws.Cells(rowNum, 4), ws.Cells(rowNum, 15)).ClearContents
|
|
ws.Cells(rowNum, 6).Validation.Delete
|
|
ws.Cells(rowNum, 19).ClearContents ' Q column error info
|
|
End Sub
|
|
|
|
Sub M2_Import()
|
|
' === Step 1: Select CSV file ===
|
|
Dim filePath As String: filePath = SelectCSVFile()
|
|
If filePath = "" Then Exit Sub
|
|
|
|
' === Step 2: Read CSV with Shift-JIS (using common function) ===
|
|
On Error GoTo ImportError
|
|
Dim csvData As Variant: csvData = ReadCSVAs2DArrayStrict(filePath, 11, "shift_jis", True)
|
|
On Error GoTo 0
|
|
|
|
If UBound(csvData, 1) < 1 Then
|
|
MsgBox "No data in CSV.", vbExclamation
|
|
Exit Sub
|
|
End If
|
|
|
|
' === Step 3:Clear all data rows before import ===
|
|
Application.EnableEvents = False
|
|
Dim wsTarget As Worksheet: Set wsTarget = Me
|
|
Call ClearDataRows(wsTarget, START_COL, ERROR_COL, 7)
|
|
Application.EnableEvents = True
|
|
|
|
' === Step 4: Write CSV data to worksheet ===
|
|
Dim colLetters As Variant: colLetters = HEADERS()
|
|
Dim writeRow As Long: writeRow = 7
|
|
Dim i As Long
|
|
For i = LBound(csvData, 1) To UBound(csvData, 1)
|
|
' CSV col 1-11 -> C, I-R column
|
|
Dim j As Long
|
|
For j = 0 To 10
|
|
wsTarget.Cells(writeRow, Columns(colLetters(j)).Column).Value = CleanCSVField(CStr(csvData(i, j + 1)))
|
|
Next j
|
|
writeRow = writeRow + 1
|
|
Next i
|
|
|
|
MsgBox writeRow - 7 & " rows imported.", vbInformation
|
|
Exit Sub
|
|
|
|
ImportError:
|
|
MsgBox "CSV import failed: " & Err.Description, vbExclamation
|
|
End Sub
|
|
|
|
Sub validate(ByVal rowNum As Long, ByVal lastDataRow As Long)
|
|
Set ws = Me
|
|
|
|
Dim clearRange As Range
|
|
Set clearRange = ws.Range(ws.Cells(rowNum, START_COL), ws.Cells(rowNum, END_COL))
|
|
clearRange.Interior.Color = vbWhite
|
|
|
|
' Check C column in the cache
|
|
If m1Cache Is Nothing Then Call RefreshM1Cache
|
|
Dim cValue As String: cValue = Trim(ws.Range("C" & rowNum).Value)
|
|
|
|
If cValue <> "" AND Not m1Cache.Exists(cValue) Then
|
|
ws.Cells(rowNum, ERROR_COL).Value = "C column does not exist in M1."
|
|
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("C", "I", "J", "K")
|
|
If Trim(ws.Range(colLetter & rowNum).Value) = "" Then
|
|
ws.Cells(rowNum, ERROR_COL).Value = colLetter & " column is required"
|
|
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, ERROR_COL).Value = col & " column must be numeric"
|
|
ws.Range(col & rowNum).Interior.Color = RGB(255, 0, 0)
|
|
Exit Sub
|
|
End If
|
|
Next col
|
|
|
|
' Check I column in the kenshuKbn
|
|
Dim kenshuKbn As Variant: kenshuKbn = Array("1", "2", "3")
|
|
Dim iValue As String: iValue = Trim(ws.Range("I" & rowNum).Value)
|
|
If UBound(Filter(kenshuKbn, iValue)) = -1 Then
|
|
ws.Cells(rowNum, ERROR_COL).Value = "I column (kenshuKbn) must be 1, 2, or 3"
|
|
ws.Range("I" & rowNum).Interior.Color = RGB(255, 0, 0)
|
|
Exit Sub
|
|
End If
|
|
|
|
End Sub
|
|
|
|
' Button macro (Validate selected row)
|
|
Sub M2_validateButton()
|
|
Dim lastDataRow As Long, r As Long, errorCount As Long
|
|
lastDataRow = GetLastDataRowInRange(Me, START_COL, END_COL)
|
|
|
|
If lastDataRow < 7 Then
|
|
MsgBox "No data found.", vbExclamation
|
|
Exit Sub
|
|
End If
|
|
|
|
For r = 7 To lastDataRow
|
|
Validate r, lastDataRow
|
|
If Trim(Cells(r, ERROR_COL).Value) <> "" Then
|
|
errorCount = errorCount + 1
|
|
End If
|
|
Next r
|
|
|
|
MsgBox "Validation complete. Errors: " & errorCount, vbInformation
|
|
End Sub
|
|
|
|
Sub M2_Export()
|
|
Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(Me, START_COL, END_COL)
|
|
If lastDataRow < 7 Then
|
|
MsgBox "No data rows to output.", vbExclamation
|
|
Exit Sub
|
|
End If
|
|
|
|
' === Step 1: Validate all rows before export ===
|
|
Dim ws As Worksheet: Set ws = Me
|
|
Dim r As Long, errorCount As Long
|
|
For r = 7 To lastDataRow
|
|
Call validate(r, lastDataRow)
|
|
If Trim(ws.Cells(r, ERROR_COL).Value) <> "" Then
|
|
errorCount = errorCount + 1
|
|
End If
|
|
Next r
|
|
|
|
If errorCount > 0 Then
|
|
MsgBox "Validation failed. Found " & errorCount & " error(s). Please correct them before exporting.", vbCritical
|
|
Exit Sub
|
|
End If
|
|
|
|
' === Step 2: Select save path ===
|
|
Dim savePath As String: savePath = GetSaveCSVPath()
|
|
If savePath = "" Then Exit Sub
|
|
|
|
' === Step 3: Count data rows ===
|
|
Dim rowCount As Long: rowCount = lastDataRow - 6
|
|
|
|
' === Step 4: Build array with header and data ===
|
|
Dim headerArr As Variant
|
|
Dim colLetters As Variant: colLetters = HEADERS()
|
|
headerArr = GetCSVHeader(ws, colLetters, M2_HEADER_ROW)
|
|
|
|
Dim outputArr As Variant
|
|
ReDim outputArr(1 To rowCount + 1, 1 To 11)
|
|
|
|
' Row 1: header
|
|
Dim colIdx As Long
|
|
For colIdx = 0 To 10
|
|
outputArr(1, colIdx + 1) = headerArr(1, colIdx + 1)
|
|
Next colIdx
|
|
|
|
' Rows 2+: data (C, I-R columns)
|
|
Dim dataRow As Long: dataRow = 2
|
|
For r = 7 To lastDataRow
|
|
For colIdx = 0 To 10
|
|
outputArr(dataRow, colIdx + 1) = CleanCSVField(ws.Cells(r, Columns(colLetters(colIdx)).Column).Value)
|
|
Next colIdx
|
|
dataRow = dataRow + 1
|
|
Next r
|
|
|
|
On Error GoTo ExportError
|
|
Call WriteCSVFromArray(savePath, outputArr, "shift_jis", False)
|
|
On Error GoTo 0
|
|
|
|
MsgBox "CSV export completed. Total data rows: " & rowCount, vbInformation
|
|
Exit Sub
|
|
|
|
ExportError:
|
|
MsgBox "CSV export failed: " & Err.Description, vbExclamation
|
|
|
|
End Sub
|
|
|
|
Sub M2_SortDataRowsByC()
|
|
Call SortDataRows(3)
|
|
End Sub
|
|
|
|
Sub M2_ToggleAutoFilter()
|
|
Call ToggleAutoFilter(START_COL, END_COL)
|
|
End Sub
|
|
|
|
Sub M2_AutoFitColumnWidth()
|
|
Call AutoFitColumnWidth(START_COL, END_COL)
|
|
End Sub |