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

next version

Browse Source
This commit is contained in:
updsv7
2026-04-18 21:42:00 +09:00
parent 7c487cba0b
commit 4a1be61150
26 changed files with 1101 additions and 769 deletions
Download Patch File Download Diff File Expand all files Collapse all files

521
src/sheet/C1.cls Normal file
View File

@@ -0,0 +1,521 @@
' ============================================================
' Module Name: Tukin_C1
' Module Desc: Commuter allowance editing sheet (no CSV import)
' Module Methods:
' - Tukin_ValidateRow
' - FillTransportFromM1KukanD
' - FillDepartureFromM1KukanD
' - FillArrivalFromM1KukanD
' - FillKukanFromM1
' - FillKanshuFromM2
' - FillCodeFromM2
' - FillAddressFromO1
' - FillZ1Dropdown
' ============================================================
' ====== (Tukin_C1) =======
' Commuter allowance editing sheet
' No CSV import - direct editing only
' ====== Constants ======
Const START_COL As Long = 3 ' C column (职员番号)
Const END_COL As Long = 56 ' BC column
Const ERROR_COL As Long = 57 ' BD column
Const Tukin_HEADER_ROW As Long = 6
' Column regions (for reference)
' D-H: 届出情報 (cols 4-8)
' I-J: 住所情報 (cols 9-10)
' K-O: 出勤情報 (cols 11-15)
' P-R: 自動車等情報 (cols 16-18)
' S-Y: 区間１情報 (cols 19-25)
' Z-AF: 区間２情報 (cols 26-32)
' AG-AM: 区間３情報 (cols 33-39)
' AN-AT: 区間４情報 (cols 40-46)
' AU-AX: 決定事項情報 (cols 47-50)
' AY-BA: 備考情報 (cols 51-53)
' BB-BC: 認定情報 (cols 54-56)
' ============================================================
' Column arrays for 4 kukan sections
' ============================================================
Private Function KUKAN_CODE_COLS() As Variant
KUKAN_CODE_COLS = Array(19, 26, 33, 40) ' S, Z, AG, AN
End Function
Private Function KUKAN_TRANSPORT_COLS() As Variant
KUKAN_TRANSPORT_COLS = Array(20, 27, 34, 41) ' T, AA, AH, AO
End Function
Private Function KUKAN_STATION_COLS() As Variant
KUKAN_STATION_COLS = Array(21, 28, 35, 42) ' U, AB, AI, AP
End Function
Private Function KUKAN_ARRIVAL_COLS() As Variant
KUKAN_ARRIVAL_COLS = Array(22, 29, 36, 43) ' V, AC, AJ, AQ
End Function
Private Function KUKAN_TICKET_COLS() As Variant
KUKAN_TICKET_COLS = Array(23, 30, 37, 44) ' W, AD, AK, AR
End Function
Private Function KUKAN_CODE2_COLS() As Variant
KUKAN_CODE2_COLS = Array(24, 31, 38, 45) ' X, AE, AL, AS
End Function
Private Function KUKAN_START_DAY_COLS() As Variant
KUKAN_START_DAY_COLS = Array(25, 32, 39, 46) ' Y, AF, AM, AT
End Function
Private Function DATE_COLS() As Variant
DATE_COLS = Array(4, 5, 6, 25, 32, 39, 46, 54) ' D, E, F, Y, AF, AM, AT, BB
End Function
' ============================================================
' Helper: Get index by value, return -1 if not found
' ============================================================
Private Function GetIdx(val As Long, arr As Variant) As Long
Dim i As Long
For i = LBound(arr) To UBound(arr)
If arr(i) = val Then
GetIdx = i
Exit Function
End If
Next i
GetIdx = -1
End Function
' ============================================================
' Event Handlers
' ============================================================
Private Sub Worksheet_Change(ByVal Target As Range)
Dim watchArea As Range
With Me
Set watchArea = Union( _
.Columns("C"), _
.Columns("D"), _
.Columns("E"), _
.Columns("F"), _
.Columns("G"), _
.Columns("I"), _
.Columns("S:W"), _
.Columns("Z:AD"), _
.Columns("AG:AK"), _
.Columns("AN:AR"), _
.Columns("BB") _
)
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
' === 3. rebuild dropdown list ===
Call RebuildDropdownsForTarget(Target)
' === Column C changes ===
If Target.Column = 3 Then
Dim cell As Range
For Each cell In Target
If Trim(cell.Value) = "" Then
Call ClearRowData(cell.Row)
Else
Call FillAddressFromO1(cell.Row)
End If
Next
End If
' === Date columns changes ===
idx = GetIdx(Target.Column, DATE_COLS)
If idx >= 0 Then
Dim cellDate As Range
For Each cellDate In Target
If Trim(cellDate.Value) <> "" Then
cellDate.Value = FormatDateInput(cellDate.Value)
End If
Next
End If
' === Transport column changes (T, AA, AH, AO) ===
Dim idx As Long
idx = GetIdx(Target.Column, KUKAN_TRANSPORT_COLS)
If idx >= 0 Then
Dim cellT As Range
For Each cellT In Target
Me.Cells(cellT.Row, KUKAN_STATION_COLS(idx)).ClearContents
Me.Cells(cellT.Row, KUKAN_ARRIVAL_COLS(idx)).ClearContents
If Trim(cellT.Value) <> "" Then
Call CreateFromStationDropdown(cellT.Row, KUKAN_TRANSPORT_COLS(idx), KUKAN_STATION_COLS(idx))
End If
Next
End If
' === Station column changes (U, AB, AI, AP) ===
idx = GetIdx(Target.Column, KUKAN_STATION_COLS)
If idx >= 0 Then
Dim cellU As Range
For Each cellU In Target
' Clear arrival value first
Me.Cells(cellU.Row, KUKAN_ARRIVAL_COLS(idx)).ClearContents
If Trim(cellU.Value) <> "" Then
Call CreateToStationDropdown(cellU.Row, KUKAN_TRANSPORT_COLS(idx), KUKAN_STATION_COLS(idx), KUKAN_ARRIVAL_COLS(idx))
End If
Next
End If
' === Arrival column changes (V, AC, AJ, AQ) ===
idx = GetIdx(Target.Column, KUKAN_ARRIVAL_COLS)
If idx >= 0 Then
Dim cellV As Range
For Each cellV In Target
If Trim(cellV.Value) <> "" Then
' Reverse lookup: find kukan code by transport + from + to
Dim foundCode As String
foundCode = FindKukanCodeByStation(cellV.Row, KUKAN_TRANSPORT_COLS(idx), KUKAN_STATION_COLS(idx), KUKAN_ARRIVAL_COLS(idx))
If foundCode <> "" Then
Me.Cells(cellV.Row, KUKAN_CODE_COLS(idx)).Value = foundCode
End If
End If
Next
End If
' === Kukan code column changes (S, Z, AG, AN) ===
idx = GetIdx(Target.Column, KUKAN_CODE_COLS)
If idx >= 0 Then
Dim cellK As Range
For Each cellK In Target
Call FillKukanFromM1(cellK.Row, idx)
Next
End If
' === Ticket column changes (W, AD, AK, AR) ===
idx = GetIdx(Target.Column, KUKAN_TICKET_COLS)
If idx >= 0 Then
Dim cellTi As Range
For Each cellTi In Target
' Clear old code first
Dim code2Col As Long: code2Col = KUKAN_CODE2_COLS(idx)
Me.Cells(cellTi.Row, code2Col).ClearContents
Me.Cells(cellTi.Row, code2Col).Validation.Delete
If Not IsError(Application.Match(cellTi.Value, Array("1", "2", "3"), 0)) Then
Call CreateM2CodeDropdown(cellTi.Row, KUKAN_CODE_COLS(idx), KUKAN_TICKET_COLS(idx), code2Col)
End If
Next
End If
Finally:
Application.EnableEvents = True '
End Sub
Private Sub RebuildDropdownsForTarget(ByVal Target As Range)
If Target Is Nothing Then Exit Sub
Dim cell As Range
Dim processedRows As Object
Set processedRows = CreateObject("Scripting.Dictionary")
For Each cell In Target
Dim r As Long
r = cell.Row
If Not processedRows.Exists(r) Then
processedRows(r) = True
Dim colLetter As String
colLetter = Split(Me.Cells(1, cell.Column).Address(True, False), "$")(0)
Dim dropdowns As Variant
dropdowns = Array( _
Array("T", "BuildTransportList"), _
Array("AA", "BuildTransportList"), _
Array("AH", "BuildTransportList"), _
Array("AO", "BuildTransportList"), _
Array("G", "BuildTodokeList"), _
Array("M", "BuildOufukuList"), _
Array("N", "BuildKoutaiList"), _
Array("AU", "BuildKetteiList"), _
Array("AW", "BuildHigaitouList"), _
Array("AX", "BuildMonthAmountKbnList"), _
Array("BC", "BuildKanshokuList") _
)
Dim i As Long
For i = LBound(dropdowns) To UBound(dropdowns)
If colLetter <> dropdowns(i)(0) Then
With Me.Cells(r, dropdowns(i)(0)).Validation
.Delete
.Add Type:=xlValidateList, Formula1:=Application.Run(dropdowns(i)(1))
.IgnoreBlank = True
.InCellDropdown = True
End With
End If
Next i
End If
NextCell:
Next cell
End Sub
' Fill kukan info from M1 cache (key: kukan code, value: 7 elements)
Private Sub FillKukanFromM1(ByVal rowNum As Long, ByVal idx As Long)
If m1Cache Is Nothing Then Call RefreshM1Cache
Dim codeCol As Long: codeCol = KUKAN_CODE_COLS(idx)
Dim transportCol As Long: transportCol = KUKAN_TRANSPORT_COLS(idx)
Dim stationCol As Long: stationCol = KUKAN_STATION_COLS(idx)
Dim arrivalCol As Long: arrivalCol = KUKAN_ARRIVAL_COLS(idx)
Dim ticketCol As Long: ticketCol = KUKAN_TICKET_COLS(idx)
Dim code2Col As Long: code2Col = KUKAN_CODE2_COLS(idx)
Dim startDayCol As Long: startDayCol = KUKAN_START_DAY_COLS(idx)
Dim code As String: code = Trim(Me.Cells(rowNum, codeCol).Value)
If code <> "" And m1Cache.Exists(code) Then
Dim vals As Variant: vals = m1Cache(code)
Me.Cells(rowNum, transportCol).Value = MakeSelect(vals(1), vals(2))
Me.Cells(rowNum, stationCol).Value = Trim(vals(3))
Me.Cells(rowNum, arrivalCol).Value = Trim(vals(4))
Else
Me.Cells(rowNum, transportCol).ClearContents
Me.Cells(rowNum, stationCol).ClearContents
Me.Cells(rowNum, arrivalCol).ClearContents
Me.Cells(rowNum, ticketCol).ClearContents
Me.Cells(rowNum, code2Col).ClearContents
Me.Cells(rowNum, startDayCol).ClearContents
Call ClearKukanValidation(rowNum, stationCol)
Call ClearKukanValidation(rowNum, arrivalCol)
Call ClearKukanValidation(rowNum, code2Col)
End If
End Sub
' Fill address dropdown from O1 cache
Private Sub FillAddressFromO1(ByVal rowNum As Long)
If o1Cache Is Nothing Then Call RefreshO1Cache
Dim empNo As String
empNo = Trim(Me.Cells(rowNum, 3).Value)
If empNo = "" Then Exit Sub
' Build dropdown list from O1 cache: get all E values for the C
Dim dropdownList As String
If o1Cache.Exists(empNo) Then
Dim innerDict As Object
Set innerDict = o1Cache(empNo)
Dim eKey As Variant
For Each eKey In innerDict.Keys
If dropdownList = "" Then
dropdownList = eKey
Else
dropdownList = dropdownList & "," & eKey
End If
Next eKey
End If
' Create dropdown for I column (住所)
If dropdownList <> "" Then
With Me.Range("I" & rowNum).Validation
.Delete
.Add Type:=xlValidateList, Formula1:=dropdownList
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.InputMessage = ""
End With
End If
End Sub
' Create station (利用区間発) dropdown from M1_KukanD cache
Private Sub CreateFromStationDropdown(ByVal rowNum As Long, ByVal transportCol As Long, ByVal stationCol As Long)
If m1KukanDCache Is Nothing Then Call RefreshM1KukanDCache
Dim transport As String: transport = GetCode(Me.Cells(rowNum, transportCol).Value)
If transport = "" Then Exit Sub
' Build dropdown list from M1_KukanD cache: get all F values for the transport (D)
Dim dropdownList As String
If m1KukanDCache.Exists(transport) Then
Dim innerDict As Object: Set innerDict = m1KukanDCache(transport)
Dim fValue As Variant
For Each fValue In innerDict.Keys
If dropdownList = "" Then
dropdownList = fValue
Else
dropdownList = dropdownList & "," & fValue
End If
Next fValue
End If
If dropdownList <> "" Then
With Me.Cells(rowNum, stationCol).Validation
.Delete
.Add Type:=xlValidateList, Formula1:=dropdownList
.IgnoreBlank = True
.InCellDropdown = True
End With
End If
End Sub
' Create destination (利用区間着) dropdown from M1_KukanD cache
' Structure: { D: { F: [G] } }
Private Sub CreateToStationDropdown(ByVal rowNum As Long, ByVal transportCol As Long, ByVal stationFromCol As Long, ByVal stationToCol As Long)
If m1KukanDCache Is Nothing Then Call RefreshM1KukanDCache
Dim transport As String: transport = GetCode(Me.Cells(rowNum, transportCol).Value)
Dim stationFrom As String: stationFrom = GetCode(Me.Cells(rowNum, stationFromCol).Value)
If transport = "" Or stationFrom = "" Then Exit Sub
' Build dropdown list from M1_KukanD cache
Dim dropdownList As String
If m1KukanDCache.Exists(transport) Then
Dim innerDict As Object: Set innerDict = m1KukanDCache(transport)
If innerDict.Exists(stationFrom) Then
Dim arr As Object: Set arr = innerDict(stationFrom)
Dim gValue As Variant
For Each gValue In arr.Keys
If dropdownList = "" Then
dropdownList = gValue
Else
dropdownList = dropdownList & "," & gValue
End If
Next gValue
End If
End If
If dropdownList <> "" Then
With Me.Cells(rowNum, stationToCol).Validation
.Delete
.Add Type:=xlValidateList, Formula1:=dropdownList
.IgnoreBlank = True
.InCellDropdown = True
End With
End If
End Sub
' Find kukan code by transport + station_from + station_to (reverse lookup)
Private Function FindKukanCodeByStation(ByVal rowNum As Long, ByVal transportCol As Long, ByVal stationFromCol As Long, ByVal stationToCol As Long) As String
If m1Cache Is Nothing Then Call RefreshM1Cache
Dim transportKbn As String: transportKbn = GetCode(Trim(Me.Cells(rowNum, transportCol).Value))
Dim stationFrom As String: stationFrom = Trim(Me.Cells(rowNum, stationFromCol).Value)
Dim stationTo As String: stationTo = Trim(Me.Cells(rowNum, stationToCol).Value)
If transportKbn = "" Or stationFrom = "" Or stationTo = "" Then
FindKukanCodeByStation = ""
Exit Function
End If
Dim code As Variant
For Each code In m1Cache.Keys
Dim vals As Variant: vals = m1Cache(code)
' vals(1) = D列(交通機関区分), vals(3) = F列(発), vals(4) = G列(着)
If vals(1) = transportKbn And vals(3) = stationFrom And vals(4) = stationTo Then
FindKukanCodeByStation = code
Exit Function
End If
Next code
FindKukanCodeByStation = ""
End Function
' Clear validation for kukan columns
Private Sub ClearKukanValidation(ByVal rowNum As Long, ByVal col As Long)
Me.Cells(rowNum, col).Validation.Delete
End Sub
' Create dropdown from M2 cache: get code (J列) list for kukanCode + kanshu
Private Sub CreateM2CodeDropdown(ByVal rowNum As Long, ByVal kukanCodeCol As Long, ByVal kanshuCol As Long, ByVal codeCol As Long)
If m2Cache Is Nothing Then Call RefreshM2Cache
Dim kukanCode As String: kukanCode = Trim(Me.Cells(rowNum, kukanCodeCol).Value)
Dim kanshu As String: kanshu = Trim(Me.Cells(rowNum, kanshuCol).Value)
If kukanCode = "" Or kanshu = "" Then Exit Sub
' Build dropdown list: get all code for kukanCode + kanshu
Dim dropdownList As String
If m2Cache.Exists(kukanCode) Then
Dim innerDict As Object: Set innerDict = m2Cache(kukanCode)
If innerDict.Exists(kanshu) Then
Dim innermostDict As Object: Set innermostDict = innerDict(kanshu)
Dim code As Variant
For Each code In innermostDict.Keys
If dropdownList = "" Then
dropdownList = MakeSelect(code, innermostDict(code))
Else
dropdownList = dropdownList & "," & code
End If
Next code
End If
End If
If dropdownList <> "" Then
With Me.Cells(rowNum, codeCol).Validation
.Delete
.Add Type:=xlValidateList, Formula1:=dropdownList
.IgnoreBlank = True
.InCellDropdown = True
End With
End If
End Sub
' Clear row data
Private Sub ClearRowData(ByVal rowNum As Long)
Me.Range(Me.Cells(rowNum, 4), Me.Cells(rowNum, END_COL)).ClearContents
Me.Cells(rowNum, ERROR_COL).ClearContents
End Sub
' ====== Button Macros ======
Private Sub validateButton()
Dim lastRow As Long, r As Long, errorCount As Long
lastRow = GetLastDataRowInRange(Me, START_COL, END_COL)
If lastRow < 7 Then
MsgBox "No data found.", vbExclamation
Exit Sub
End If
errorCount = 0
For r = 7 To lastRow
Call Validate(r)
If Trim(Cells(r, ERROR_COL).Value) <> "" Then
errorCount = errorCount + 1
End If
Next r
MsgBox "Validation complete. Errors: " & errorCount, vbInformation
End Sub
' Validation logic
Private Private Sub validate(ByVal rowNum As Long)
Set ws = Me
' Clear background color
Me.Range(Me.Cells(rowNum, START_COL), Me.Cells(rowNum, END_COL)).Interior.Color = vbWhite
' Required columns: C-G, K-N, AW
Dim requiredCols As Variant
requiredCols = Array("C", "D", "E", "F", "G", "K", "L", "M", "N", "AW")
Dim col As Variant
For Each col In requiredCols
If Trim(Me.Range(col & rowNum).Value & "") = "" Then
Me.Cells(rowNum, ERROR_COL).Value = col & " column is required"
Me.Range(col & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Next col
Me.Cells(rowNum, ERROR_COL).ClearContents
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

305
src/sheet/M1.cls Normal file
View File

@@ -0,0 +1,305 @@
' ============================================================
' Module Name: Master_Kukan
' Module Desc: M1 Kukan master data management (import/export/validate)
' Module Methods:
' - Import
' - Export
' - validateButton_Click
' - SortData
' - ToggleAutoFilter
' - Worksheet_Change
' - ValidateRow
' - FillValidationDropdown
' - ValidateAllRows
' ============================================================
' ====== Constants ======
Const START_COL As Long = 3 ' C column
Const END_COL As Long = 14 ' N column
Const ERROR_COL As Long = 15 ' O column
Const HEADER_ROW As Long = 5
Function HEADERS() As Variant
HEADERS = Array("C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N")
End Function
' Create dropdown for L column
Private Sub CreateEnumDropdown(ByVal rowNum As Long)
If tokubetuList Is Nothing Then Call GetTokubetu
' Build dropdown list from tokubetuList
Dim dropdownList As String
dropdownList = ""
Dim key As Variant
For Each key In tokubetuList.Keys
If dropdownList = "" Then
dropdownList = key
Else
dropdownList = dropdownList & "," & key
End If
Next key
With Me.Range("L" & rowNum).Validation
.Delete
.Add Type:=xlValidateList, Formula1:=dropdownList
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.InputMessage = ""
End With
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
' === Column C changes: Create L column dropdown ===
If Target.Column = 3 And Target.Row >= 7 Then
Dim cell As Range
For Each cell In Target
If Trim(cell.Value) = "" Then
Me.Cells(cell.Row, 12).Validation.Delete
Call ClearDataRow(Me, START_COL + 1, END_COL, cell.Row, ERROR_COL)
Else
Call CreateEnumDropdown(cell.Row)
End If
Next
End If
' === Column D changes: Fill E column ===
If Target.Column = 4 And Target.Row >= 7 Then
If z1Cache Is Nothing Then Call RefreshZ1Cache
Dim cellD As Range
For Each cellD In Target
Dim dVal As String: dVal = Trim(cellD.Value)
If dVal = "" Then
Me.Cells(cellD.Row, 5).ClearContents
Else
If Not z1Cache Is Nothing And z1Cache.Exists(dVal) Then
Dim valsD As Variant: valsD = z1Cache(dVal)
Me.Cells(cellD.Row, 5).Value = valsD(0)
Else
Me.Cells(cellD.Row, 5).ClearContents
End If
End If
Next
End If
End Sub
Sub Import(wsTarget As Worksheet)
' === 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, 12, "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
Call ClearDataRows(wsTarget, START_COL, END_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-12 -> C-N column
Dim j As Long
For j = 0 To 11
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(ws As Worksheet, ByVal rowNum As Long, ByVal lastDataRow As Long)
Dim clearRange As Range
Set clearRange = ws.Range(ws.Cells(rowNum, START_COL), ws.Cells(rowNum, END_COL))
clearRange.Interior.Color = vbWhite
' Check column required
Dim colLetter As Variant
For Each colLetter In Array("C", "D", "E", "F", "G", "I", "L")
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
For Each colLetter In Array("H", "I", "J", "N")
Dim val As String: val = Trim(ws.Range(colLetter & rowNum).Value)
If val <> "" And Not IsNumeric(val) Then
ws.Cells(rowNum, ERROR_COL).Value = colLetter & " column must be numeric"
ws.Range(colLetter & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Next colLetter
' Check C column repeat
Dim cValue As String: cValue = Trim(ws.Range("C" & rowNum).Value)
Dim foundCell As Range
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 foundCell.Row <> rowNum Then
ws.Cells(rowNum, ERROR_COL).Value = "C column value is duplicated"
ws.Range("C" & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
End If
' Check D and E column in the cache
If z1Cache Is Nothing Then Call RefreshZ1Cache
Dim dValue As String: dValue = Trim(ws.Range("D" & rowNum).Value)
Dim eValue As String: eValue = Trim(ws.Range("E" & rowNum).Value)
If Not z1Cache.Exists(dValue) Then
ws.Cells(rowNum, ERROR_COL).Value = "D column does not exist."
ws.Range("D" & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
Else
Dim valueArray As Variant
valueArray = z1Cache(dValue)
If Not IsArray(valueArray) Or UBound(valueArray) < 0 Then
ws.Cells(rowNum, ERROR_COL).Value = "Invalid reference data for D column."
Exit Sub
End If
Dim expectedEValue As String
expectedEValue = Trim(CStr(valueArray(0)))
If eValue <> expectedEValue Then
ws.Cells(rowNum, ERROR_COL).Value = "E column does not match reference data."
ws.Range("E" & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
End If
' Check L column in the tokubetuList
If tokubetuList Is Nothing Then Call GetTokubetu
Dim lValue As String: lValue = Trim(ws.Range("L" & rowNum).Value)
If Not tokubetuList.Exists(lValue) Then
ws.Cells(rowNum, ERROR_COL).Value = "L column does not exist."
ws.Range("L" & rowNum).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
' Validation passed - clear error
ws.Cells(rowNum, ERROR_COL).ClearContents
End Sub
' Validate button
Sub validateAll(ws As Worksheet)
Dim lastDataRow As Long, r As Long, errorCount As Long
lastDataRow = GetLastDataRowInRange(ws, 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(ws.Cells(r, ERROR_COL).Value) <> "" Then
errorCount = errorCount + 1
End If
Next r
' === Refresh M1 cache after validation passes ===
If errorCount = 0 Then
Call RefreshM1Cache
End If
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 12)
' Row 1: header
Dim colIdx As Long
For colIdx = 0 To 11
outputArr(1, colIdx + 1) = headerArr(1, colIdx + 1)
Next colIdx
' Rows 2+: data (C-N columns)
Dim dataRow As Long: dataRow = 2
For r = 7 To lastDataRow
For colIdx = 0 To 11
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

267
src/sheet/M2.cls Normal file
View File

@@ -0,0 +1,267 @@
' ============================================================
' 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
' ============================================================
' ====== 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
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
Private Sub 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
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))
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)
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

60
src/sheet/O1.cls Normal file
View File

@@ -0,0 +1,60 @@
' ============================================================
' Module Name: Master_address
' Module Desc: O1 address master data management
' Module Methods:
' - Import
' - Export
' - SortData
' - ToggleAutoFilter
' ============================================================
Private Sub Import()
Dim filePath As String
Dim lines As Variant
Dim i As Long
Dim writeRow As Long
Set ws = Me
On Error GoTo ErrorHandler
' Step 1: Select CSV file
filePath = SelectCSVFile()
If filePath = "" Then Exit Sub
' Step 2: Read CSV and return 2D array
lines = ReadCSVAs2DArrayStrict(filePath, 4, "shift-jis", True)
' Step 3: Clear data rows
Call Generic_ClearDataRows(ws, 7, 3)
' Step 4: Import data
writeRow = 7
For i = LBound(lines, 1) To UBound(lines, 1)
If Not isRowEmpty Then
Dim colOffset As Long
For colOffset = 1 To 4
ws.Cells(writeRow, 2 + colOffset).Value = CleanCSVField(CStr(lines(i, colOffset)))
Next colOffset
writeRow = writeRow + 1
End If
Next i
MsgBox writeRow - 7 & " rows imported.", vbInformation
Exit Sub
ErrorHandler:
MsgBox "Import fails:" & vbCrLf & Err.Description, vbCritical
End Sub
Private Sub Do_Sort()
Call SortDataRows(3)
End Sub
Private Sub Do_Filter()
Call ToggleAutoFilter(3, 5)
End Sub
Private Sub Do_Fit()
Call AutoFitColumnWidth(3, 5)
End Sub

25
src/sheet/O2.cls Normal file
View File

@@ -0,0 +1,25 @@
' ============================================================
' Module Name: Master_507
' Module Desc: O2 master data management (507)
' Module Methods:
' - Import
' - Export
' - SortData
' - ToggleAutoFilter
' ============================================================
' ====== (507) =======
Private Sub Import()
Call Generic_Master_Import(Me, 13)
End Sub
Private Sub Do_Sort()
Call SortDataRows(3)
End Sub
Private Sub Do_Filter()
Call ToggleAutoFilter(3, 15)
End Sub
Private Sub Do_Fit()
Call AutoFitColumnWidth(3, 15)
End Sub

181
src/sheet/Z1.cls Normal file
View File

@@ -0,0 +1,181 @@
' ============================================================
' Module Name: Master_222
' Module Desc: Z1 master data management (222)
' Module Methods:
' - Import
' - Export
' - SortData
' - ToggleAutoFilter
' ============================================================
' ====== (222) =======
' ====== Constants ======
Const START_COL As Long = 3
Const END_COL As Long = 9
Const ERROR_COL As Long = 2
' ====== Function ======
Private Sub Import()
Call Generic_Master_Import(Me, 7)
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
Dim r As Long, errorCount As Long
For r = 7 To lastDataRow
Validate r
If Trim(Cells(r, 2).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
Call Generic_Master_Export(Me, 7, lastDataRow)
End Sub
Private Sub validate(ByVal rowNum As Long)
Set ws = Me
Dim cValue As String: cValue = Trim(ws.Cells(rowNum, 3).Value)
' clear C~I columns background color
Dim clearRange As Range
Set clearRange = ws.Range(ws.Cells(rowNum, START_COL), ws.Cells(rowNum, END_COL))
clearRange.Interior.Color = vbWhite
If cValue = "" Then
ws.Cells(rowNum, 2).Value = "C column is required"
ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If Len(cValue) <> 3 Then
ws.Cells(rowNum, 2).Value = "C column must be 3 characters"
ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Dim i As Long
Dim ch As String
For i = 1 To 3
ch = Mid(cValue, i, 1)
If Not ((ch >= "0" And ch <= "9") Or (ch >= "A" And ch <= "Z") Or (ch >= "a" And ch <= "z")) Then
ws.Cells(rowNum, 2).Value = "C column must be alphanumeric"
ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Next i
Dim dValue As String
dValue = Trim(ws.Cells(rowNum, 4).Value)
If dValue = "" Then
ws.Cells(rowNum, 2).Value = "D column is required"
ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If Len(dValue) > 80 Then
ws.Cells(rowNum, 2).Value = "D column must be within 80 characters"
ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Dim eValue As String
eValue = Trim(ws.Cells(rowNum, 5).Value)
If eValue = "" Then
ws.Cells(rowNum, 2).Value = "E column is required"
ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If Len(eValue) > 80 Then
ws.Cells(rowNum, 2).Value = "E column must be within 80 characters"
ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Dim fValue As String
fValue = Trim(ws.Cells(rowNum, 6).Value)
If fValue <> "" And Len(fValue) > 80 Then
ws.Cells(rowNum, 2).Value = "F column must be within 80 characters"
ws.Cells(rowNum, 6).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Dim gValue As String
gValue = Trim(ws.Cells(rowNum, 7).Value)
If gValue <> "" And Len(gValue) > 80 Then
ws.Cells(rowNum, 2).Value = "G column must be within 80 characters"
ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Dim hValue As String
hValue = Trim(ws.Cells(rowNum, 8).Value)
If hValue <> "" Then
If Len(hValue) <> 1 Then
ws.Cells(rowNum, 2).Value = "H column must be 1 digit"
ws.Cells(rowNum, 8).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If hValue <> "0" And hValue <> "1" Then
ws.Cells(rowNum, 2).Value = "H column must be 0 or 1"
ws.Cells(rowNum, 8).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
End If
Dim iValue As String
iValue = Trim(ws.Cells(rowNum, 9).Value)
If iValue <> "" And Len(iValue) > 80 Then
ws.Cells(rowNum, 2).Value = "I column must be within 80 characters"
ws.Cells(rowNum, 9).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
ws.Cells(rowNum, 2).ClearContents
End Sub
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
errorCount = 0
For r = 7 To lastDataRow
Validate r
If Trim(Cells(r, ERROR_COL).Value) <> "" Then
errorCount = errorCount + 1
End If
Next r
' === Refresh Z1 cache after validation passes ===
If errorCount = 0 Then
Call RefreshZ1Cache
End If
MsgBox "Validation complete. Errors: " & errorCount, vbInformation
End Sub
Private Sub Do_Sort()
Call SortDataRows(3)
End Sub
Private Sub Do_Filter()
Call ToggleAutoFilter(2, END_COL)
End Sub
Private Sub Do_Fit()
Call AutoFitColumnWidth(2, END_COL)
End Sub

165
src/sheet/Z2.cls Normal file
View File

@@ -0,0 +1,165 @@
' ============================================================
' Module Name: Master_223
' Module Desc: Z2 master data management (223)
' Module Methods:
' - Import
' - Export
' - SortData
' - ToggleAutoFilter
' ============================================================
' ====== (223) =======
' ====== Constants ======
Const START_COL As Long = 3
Const END_COL As Long = 7
Const ERROR_COL As Long = 2
' ====== Function ======
Private Sub Import()
Call Generic_Master_Import(Me, 5)
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
Dim r As Long, errorCount As Long
For r = 7 To lastDataRow
Validate r
If Trim(Cells(r, 2).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
Call Generic_Master_Export(Me, 5, lastDataRow)
End Sub
Private Sub validate(ByVal rowNum As Long)
Set ws = Me
Dim cValue As String: cValue = Trim(ws.Cells(rowNum, 3).Value)
' clear C~I columns background color
Dim clearRange As Range
Set clearRange = ws.Range(ws.Cells(rowNum, START_COL), ws.Cells(rowNum, END_COL))
clearRange.Interior.Color = vbWhite
If cValue = "" Then
ws.Cells(rowNum, 2).Value = "C column is required"
ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If Len(cValue) <> 3 Then
ws.Cells(rowNum, 2).Value = "C column must be 3 characters"
ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Dim i As Long
Dim ch As String
For i = 1 To 3
ch = Mid(cValue, i, 1)
If Not ((ch >= "0" And ch <= "9") Or (ch >= "A" And ch <= "Z") Or (ch >= "a" And ch <= "z")) Then
ws.Cells(rowNum, 2).Value = "C column must be alphanumeric"
ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Next i
Dim dValue As String
dValue = Trim(ws.Cells(rowNum, 4).Value)
If dValue = "" Then
ws.Cells(rowNum, 2).Value = "D column is required"
ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If Len(dValue) > 80 Then
ws.Cells(rowNum, 2).Value = "D column must be within 80 characters"
ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Dim eValue As String
eValue = Trim(ws.Cells(rowNum, 5).Value)
If eValue = "" Then
ws.Cells(rowNum, 2).Value = "E column is required"
ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If Len(eValue) > 80 Then
ws.Cells(rowNum, 2).Value = "E column must be within 80 characters"
ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Dim fValue As String
fValue = Trim(ws.Cells(rowNum, 6).Value)
If fValue <> "" And Len(fValue) > 80 Then
ws.Cells(rowNum, 2).Value = "F column must be within 80 characters"
ws.Cells(rowNum, 6).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Dim hValue As String
hValue = Trim(ws.Cells(rowNum, 7).Value)
If hValue <> "" Then
If Len(hValue) <> 1 Then
ws.Cells(rowNum, 2).Value = "G column must be 1 digit"
ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If hValue <> "0" And hValue <> "1" Then
ws.Cells(rowNum, 2).Value = "G column must be 0 or 1"
ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
End If
ws.Cells(rowNum, 2).ClearContents
End Sub
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
errorCount = 0
For r = 7 To lastDataRow
Validate r
If Trim(Cells(r, ERROR_COL).Value) <> "" Then
errorCount = errorCount + 1
End If
Next r
' === Refresh Z2 cache after validation passes ===
If errorCount = 0 Then
Call RefreshZ2Cache
End If
MsgBox "Validation complete. Errors: " & errorCount, vbInformation
End Sub
Private Sub Do_Sort()
Call SortDataRows(3)
End Sub
Private Sub Do_Filter()
Call ToggleAutoFilter(2, END_COL)
End Sub
Private Sub Do_Fit()
Call AutoFitColumnWidth(2, END_COL)
End Sub

173
src/sheet/Z3.cls Normal file
View File

@@ -0,0 +1,173 @@
' ============================================================
' Module Name: Master_Z3_224
' Module Desc: Z3 master data management (224)
' Module Methods:
' - Z3_Import
' - Z3_Export
' - Z3_SortDataRowsByC
' - Z3_ToggleAutoFilter
' ============================================================
' ====== (224) =======
' ====== Constants ======
Const START_COL As Long = 3
Const END_COL As Long = 8
Const ERROR_COL As Long = 2
' ====== Function ======
Private Sub Import()
Call Generic_Master_Import(Me, 6)
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
Dim r As Long, errorCount As Long
For r = 7 To lastDataRow
Validate r
If Trim(Cells(r, 2).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
Call Generic_Master_Export(Me, 6, lastDataRow)
End Sub
Private Sub validate(ByVal rowNum As Long)
Set ws = Me
Dim cValue As String: cValue = Trim(ws.Cells(rowNum, 3).Value)
' clear C~I columns background color
Dim clearRange As Range
Set clearRange = ws.Range(ws.Cells(rowNum, START_COL), ws.Cells(rowNum, END_COL))
clearRange.Interior.Color = vbWhite
If cValue = "" Then
ws.Cells(rowNum, 2).Value = "C column is required"
ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If Len(cValue) <> 3 Then
ws.Cells(rowNum, 2).Value = "C column must be 3 characters"
ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Dim i As Long
Dim ch As String
For i = 1 To 3
ch = Mid(cValue, i, 1)
If Not ((ch >= "0" And ch <= "9") Or (ch >= "A" And ch <= "Z") Or (ch >= "a" And ch <= "z")) Then
ws.Cells(rowNum, 2).Value = "C column must be alphanumeric"
ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Next i
Dim dValue As String
dValue = Trim(ws.Cells(rowNum, 4).Value)
If dValue = "" Then
ws.Cells(rowNum, 2).Value = "D column is required"
ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If Len(dValue) > 80 Then
ws.Cells(rowNum, 2).Value = "D column must be within 80 characters"
ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Dim eValue As String
eValue = Trim(ws.Cells(rowNum, 5).Value)
If eValue = "" Then
ws.Cells(rowNum, 2).Value = "E column is required"
ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If Len(eValue) > 80 Then
ws.Cells(rowNum, 2).Value = "E column must be within 80 characters"
ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Dim fValue As String
fValue = Trim(ws.Cells(rowNum, 6).Value)
If fValue <> "" And Len(fValue) > 80 Then
ws.Cells(rowNum, 2).Value = "F column must be within 80 characters"
ws.Cells(rowNum, 6).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Dim hValue As String
hValue = Trim(ws.Cells(rowNum, 7).Value)
If hValue <> "" Then
If Len(hValue) <> 1 Then
ws.Cells(rowNum, 2).Value = "G column must be 1 digit"
ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If hValue <> "0" And hValue <> "1" Then
ws.Cells(rowNum, 2).Value = "G column must be 0 or 1"
ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
End If
Dim iValue As String
iValue = Trim(ws.Cells(rowNum, 8).Value)
If iValue <> "" And Len(iValue) > 80 Then
ws.Cells(rowNum, 2).Value = "H column must be within 80 characters"
ws.Cells(rowNum, 8).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
ws.Cells(rowNum, 2).ClearContents
End Sub
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
errorCount = 0
For r = 7 To lastDataRow
Validate r
If Trim(Cells(r, ERROR_COL).Value) <> "" Then
errorCount = errorCount + 1
End If
Next r
' === Refresh Z3 cache after validation passes ===
If errorCount = 0 Then
Call RefreshZ3Cache
End If
MsgBox "Validation complete. Errors: " & errorCount, vbInformation
End Sub
Private Sub Do_Sort()
Call SortDataRows(3)
End Sub
Private Sub Do_Filter()
Call ToggleAutoFilter(2, END_COL)
End Sub
Private Sub Do_Fit()
Call AutoFitColumnWidth(2, END_COL)
End Sub

173
src/sheet/Z4.cls Normal file
View File

@@ -0,0 +1,173 @@
' ============================================================
' Module Name: Master_Z4_220
' Module Desc: Z4 master data management (220)
' Module Methods:
' - Z4_Import
' - Z4_Export
' - Z4_SortDataRowsByC
' - Z4_ToggleAutoFilter
' ============================================================
' ====== (220) =======
' ====== Constants ======
Const START_COL As Long = 3
Const END_COL As Long = 9
Const ERROR_COL As Long = 2
' ====== Function ======
Private Sub Import()
Call Generic_Master_Import(Me, 7)
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
Dim r As Long, errorCount As Long
For r = 7 To lastDataRow
Validate r
If Trim(Cells(r, 2).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
Call Generic_Master_Export(Me, 7, lastDataRow)
End Sub
Private Sub validate(ByVal rowNum As Long)
Set ws = Me
Dim cValue As String: cValue = Trim(ws.Cells(rowNum, 3).Value)
' clear C~I columns background color
Dim clearRange As Range
Set clearRange = ws.Range(ws.Cells(rowNum, START_COL), ws.Cells(rowNum, END_COL))
clearRange.Interior.Color = vbWhite
If cValue = "" Then
ws.Cells(rowNum, 2).Value = "C column is required"
ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If Len(cValue) <> 3 Then
ws.Cells(rowNum, 2).Value = "C column must be 3 characters"
ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Dim i As Long
Dim ch As String
For i = 1 To 3
ch = Mid(cValue, i, 1)
If Not ((ch >= "0" And ch <= "9") Or (ch >= "A" And ch <= "Z") Or (ch >= "a" And ch <= "z")) Then
ws.Cells(rowNum, 2).Value = "C column must be alphanumeric"
ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Next i
Dim dValue As String
dValue = Trim(ws.Cells(rowNum, 4).Value)
If dValue = "" Then
ws.Cells(rowNum, 2).Value = "D column is required"
ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If Len(dValue) > 80 Then
ws.Cells(rowNum, 2).Value = "D column must be within 80 characters"
ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Dim eValue As String
eValue = Trim(ws.Cells(rowNum, 5).Value)
If eValue = "" Then
ws.Cells(rowNum, 2).Value = "E column is required"
ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If Len(eValue) > 80 Then
ws.Cells(rowNum, 2).Value = "E column must be within 80 characters"
ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Dim fValue As String
fValue = Trim(ws.Cells(rowNum, 6).Value)
If fValue <> "" And Len(fValue) > 80 Then
ws.Cells(rowNum, 2).Value = "F column must be within 80 characters"
ws.Cells(rowNum, 6).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
Dim hValue As String
hValue = Trim(ws.Cells(rowNum, 7).Value)
If hValue <> "" Then
If Len(hValue) <> 1 Then
ws.Cells(rowNum, 2).Value = "G column must be 1 digit"
ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
If hValue <> "0" And hValue <> "1" Then
ws.Cells(rowNum, 2).Value = "G column must be 0 or 1"
ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
End If
Dim iValue As String
iValue = Trim(ws.Cells(rowNum, 8).Value)
If iValue <> "" And Len(iValue) > 80 Then
ws.Cells(rowNum, 2).Value = "H column must be within 80 characters"
ws.Cells(rowNum, 8).Interior.Color = RGB(255, 0, 0)
Exit Sub
End If
ws.Cells(rowNum, 2).ClearContents
End Sub
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
errorCount = 0
For r = 7 To lastDataRow
Validate r
If Trim(Cells(r, ERROR_COL).Value) <> "" Then
errorCount = errorCount + 1
End If
Next r
' === Refresh Z4 cache after validation passes ===
If errorCount = 0 Then
Call RefreshZ4Cache
End If
MsgBox "Validation complete. Errors: " & errorCount, vbInformation
End Sub
Private Sub Do_Sort()
Call SortDataRows(3)
End Sub
Private Sub Do_Filter()
Call ToggleAutoFilter(2, END_COL)
End Sub
Private Sub Do_Fit()
Call AutoFitColumnWidth(2, END_COL)
End Sub