updsv7/vba
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refactor

Browse Source
This commit is contained in:
simple321vip
2026-04-19 16:44:14 +08:00
parent 4a1be61150
commit de3f513230
19 changed files with 688 additions and 1065 deletions
Download Patch File Download Diff File Expand all files Collapse all files

185
src/sheet/M2.cls
View File

@@ -2,28 +2,11 @@
' Module Name: Master_Kukan_detail
' Module Desc: M2 Kukan detail master data management
' Module Methods:
' - Import
' - Export
' - validateButton_Click
' - SortData
' - ToggleAutoFilter
' - Worksheet_Change
' - ValidateRow
' - FillValidationDropdown
' - ValidateAllRows
' - FillFromM1
' - validateButton_Click
' - Validate
' ============================================================
' ====== 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 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
@@ -38,10 +21,10 @@ Private Sub Worksheet_Change(ByVal Target As Range)
End If
End Sub
Sub FillFromM1(ByVal rowNum As Long, Optional ByVal setG As Boolean = True)
Private Sub FillFromM1(ByVal rowNum As Long, Optional ByVal setG As Boolean = True)
Set ws = Me
If m1Cache Is Nothing Then Call RefreshM1Cache
Dim m1Cache As Object: Set m1Cache = GetM1Cache()
Dim cValue As String: cValue = Trim(ws.Range("C" & rowNum).Value)
' Fill D, E, F, G, H columns from M1 cache
@@ -72,67 +55,31 @@ Sub FillFromM1(ByVal rowNum As Long, Optional ByVal setG As Boolean = True)
ws.Cells(rowNum, 8).Value = Trim(cacheVal(6))
End Sub
Sub ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long)
Private 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
Private Sub Import()
' === Step 1: Select CSV file ===
Dim filePath As String: filePath = SelectCSVFile()
If filePath = "" Then Exit Sub
Public Sub Validate(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
' === 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
Dim sheetConfDict As Object: Set sheetConfDict = GetSheetConfig()
Dim sheetConf As Object: Set sheetConf = sheetConfDict(ws.CodeName)
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
Dim startCol As String: startCol = sheetConf("StartCol")
Dim endCol As String: endCol = sheetConf("EndCol")
Dim errorCol As String: errorCol = sheetConf("ErrorCol")
' === 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
Private 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))
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
If m1Cache Is Nothing Then Call RefreshM1Cache
Dim m1Cache As Object: Set m1Cache = GetM1Cache()
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.Cells(rowNum, errorCol).Value = "C column does not exist in M1."
ws.Range("C" & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
@@ -141,7 +88,7 @@ Private Sub validate(ByVal rowNum As Long, ByVal lastDataRow As Long)
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.Cells(rowNum, errorCol).Value = colLetter & " column is required"
ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
@@ -153,7 +100,7 @@ Private Sub validate(ByVal rowNum As Long, ByVal lastDataRow As Long)
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.Cells(rowNum, errorCol).Value = col & " column must be numeric"
ws.Range(col & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
@@ -163,105 +110,9 @@ Private Sub validate(ByVal rowNum As Long, ByVal lastDataRow As Long)
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.Cells(rowNum, errorCol).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)
Private Sub 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
Private Sub 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, 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
Private Sub Do_Sort()
Call SortDataRows(3)
End Sub
Private Sub Do_Filter()
Call ToggleAutoFilter(START_COL, END_COL)
End Sub
Private Sub Do_Fit()
Call AutoFitColumnWidth(START_COL, END_COL)
End Sub