update Master_M1_Kukan

This commit is contained in:
updsv7
2026-04-15 18:19:13 +09:00
parent d32e339d52
commit 60c55a40c1
8 changed files with 86 additions and 61 deletions

View File

@@ -1,12 +1,6 @@
' ============================================================
' Generic Master Common Functions
' ============================================================
Sub Generic_Master_ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long)
ws.Range(ws.Cells(rowNum, 4), ws.Cells(rowNum, 15)).ClearContents
ws.Cells(rowNum, 2).ClearContents
End Sub
Sub Generic_Master_Import(ByVal ws As Worksheet, ByVal expectedColumnCount As Long)
Dim filePath As String
Dim lines As Variant
@@ -23,7 +17,7 @@ Sub Generic_Master_Import(ByVal ws As Worksheet, ByVal expectedColumnCount As Lo
lines = ReadCSVAs2DArrayStrict(filePath, expectedColumnCount, "utf-8")
' Step 3: Clear data rows
Call ClearDataRows(ws, 7, 3)
Call Generic_ClearDataRows(ws, 7, 3)
' Step 4: Import data
writeRow = 7
@@ -90,3 +84,12 @@ Sub Generic_Master_Export(ByVal ws As Worksheet, ByVal expectedColumnCount As Lo
MsgBox "CSV export completed. Total data rows: " & rowCount, vbInformation
End Sub
Sub Generic_ClearDataRows(ByVal ws As Worksheet, ByVal startRow As Long, ByVal columnNum As Long)
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, columnNum).End(xlUp).Row
If lastRow >= startRow Then
ws.Range(ws.Cells(startRow, 1), ws.Cells(lastRow, 20)).ClearContents
End If
End Sub

View File

@@ -132,14 +132,22 @@ Function GetLastDataRowInRange(ws As Worksheet, ByVal startCol As Long, ByVal en
GetLastDataRowInRange = maxRow
End Function
Sub ClearDataRows(ByVal ws As Worksheet, ByVal startRow As Long, ByVal columnNum As Long)
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, columnNum).End(xlUp).Row
If lastRow >= startRow Then
ws.Range(ws.Cells(startRow, 1), ws.Cells(lastRow, 20)).ClearContents
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
Dim clearRange As Range: Set clearRange = ws.Range(ws.Cells(rowRow, startCol), ws.Cells(rowRow, endCol))
clearRange.ClearContents
clearRange.Interior.Color = vbWhite
ws.Range(ws.Cells(rowRow, errorCol), ws.Cells(rowRow, errorCol)).ClearContents
End If
End Sub
End Function
Function ClearDataRows(ByVal ws As Worksheet, ByVal startCol As Long, ByVal endCol As Long, Optional ByVal startRow As Long = 7)
Dim lastDataRow As Long: lastDataRow = GetLastDataRowInRange(ws, startCol, endCol, startRow)
If lastDataRow >= startRow Then
ws.Range(ws.Cells(startRow, startCol), ws.Cells(lastDataRow, endCol)).ClearContents
End If
End Function
Sub SortDataRows(Optional ByVal sortColumn As Long = 3)
Dim ws As Worksheet

View File

@@ -26,17 +26,45 @@ End Sub
Public Sub RefreshEnumCache()
On Error GoTo RefreshError
Set tokubetuKbn = LoadLookup("Enum", keyCol:=3, valueCols:=Array(3), startRow:=3)
Set tokubetuKbn = LoadLookup("Enum", keyCol:=1, valueCols:=Array(1), startRow:=3)
Set enumCache = tokubetuKbn
On Error GoTo 0
If tokubetuKbn Is Nothing Or tokubetuKbn.Count = 0 Then
Err.Raise 1003, "RefreshZ1Cache", "Enum reference data is empty"
If enumCache Is Nothing Or enumCache.Count = 0 Then
Err.Raise 1003, "RefreshEnumCache", "Enum reference data is empty"
End If
Exit Sub
RefreshError:
Err.Raise 1001, "RefreshZ1Cache", "Failed to load Z1 lookup cache: " & Err.Description
Err.Raise 1001, "RefreshEnumCache", "Failed to load Enum lookup cache: " & Err.Description
End Sub
' Create dropdown for L column
Private Sub CreateEnumDropdown(ByVal rowNum As Long)
If enumCache Is Nothing Then Call RefreshEnumCache
' Build dropdown list from enumCache keys
Dim dropdownList As String
dropdownList = ""
Dim key As Variant
For Each key In enumCache.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
' Get CSV header from row 5 (columns C to N)
@@ -52,21 +80,34 @@ Function GetM1CSVHeader(ByVal ws As Worksheet) As Variant
End Function
Private Sub Worksheet_Change(ByVal Target As Range)
' === Fill D, E columns when C column changes ===
' === 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 cell As Range
For Each cell In Target
Dim dVal As String: dVal = Trim(cell.Value)
Dim cellD As Range
For Each cellD In Target
Dim dVal As String: dVal = Trim(cellD.Value)
If dVal = "" Then
Me.Cells(cell.Row, 5).ClearContents
Me.Cells(cellD.Row, 5).ClearContents
Else
If Not z1Cache Is Nothing And z1Cache.Exists(dVal) Then
Dim vals As Variant: vals = z1Cache(dVal)
Me.Cells(cell.Row, 5).Value = vals(0)
Dim valsD As Variant: valsD = z1Cache(dVal)
Me.Cells(cellD.Row, 5).Value = valsD(0)
Else
Me.Cells(cell.Row, 5).ClearContents
Me.Cells(cellD.Row, 5).ClearContents
End If
End If
Next
@@ -103,13 +144,7 @@ Sub ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long)
End Sub
Sub M1_Import()
Dim wsTarget As Worksheet
Dim csvData As Variant
Dim i As Long
Dim writeRow As Long
' Target this worksheet
Set wsTarget = Me
Dim wsTarget As Worksheet: Set wsTarget = Me
' === Step 1: Select CSV file ===
Dim filePath As String
@@ -118,34 +153,25 @@ Sub M1_Import()
' === Step 2: Read CSV with Shift-JIS (using common function) ===
On Error GoTo ImportError
csvData = ReadCSVAs2DArrayStrict(filePath, 12, "shift_jis", False)
Dim csvData As Variant: csvData = ReadCSVAs2DArrayStrict(filePath, 12, "shift_jis", True)
On Error GoTo 0
' === Clear all data rows before import ===
Dim lastRow As Long
lastRow = wsTarget.Cells(wsTarget.Rows.Count, "C").End(xlUp).Row
If lastRow >= 7 Then
wsTarget.Range("A7:N" & lastRow).ClearContents
End If
If UBound(csvData, 1) < 1 Then
MsgBox "No data in CSV.", vbExclamation
Exit Sub
End If
' === Step 3:Clear all data rows before import ===
Call ClearDataRows(wsTarget, START_COL, END_COL, 7)
' === Step 3: Write CSV data to worksheet (forward order) ===
writeRow = 7
Dim i As Long
Dim writeRow As Long: writeRow = 7
For i = LBound(csvData, 1) To UBound(csvData, 1)
' CSV col 1-12 -> C-N column
Dim j As Long
For j = 1 To 12
wsTarget.Cells(writeRow, j + 2).Value = CleanCSVField(CStr(csvData(i, j)))
Next j
' Auto-fill D, E columns from Z1
Call FillFromZ1(writeRow)
writeRow = writeRow + 1
Next i
@@ -174,7 +200,7 @@ Sub validate(ByVal rowNum As Long, ByVal lastDataRow As Long)
Next colLetter
' Check column numeric
For Each colLetter In Array("H", "I", "G", "N")
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"

View File

@@ -16,7 +16,7 @@ Sub O1_Import()
lines = ReadCSVAs2DArrayStrict(filePath, 4, "shift-jis", True)
' Step 3: Clear data rows
Call ClearDataRows(ws, 7, 3)
Call Generic_ClearDataRows(ws, 7, 3)
' Step 4: Import data
writeRow = 7

View File

@@ -6,10 +6,6 @@ Const END_COL As Long = 9
Const ERROR_COL As Long = 2
' ====== Function ======
Sub Z1_ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long)
Call Generic_Master_ClearRowData(ws, rowNum)
End Sub
Sub Z1_Import()
Call Generic_Master_Import(Me, 7)
End Sub

View File

@@ -6,10 +6,6 @@ Const END_COL As Long = 7
Const ERROR_COL As Long = 2
' ====== Function ======
Sub Z2_ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long)
Call Generic_Master_ClearRowData(ws, rowNum)
End Sub
Sub Z2_Import()
Call Generic_Master_Import(Me, 5)
End Sub

View File

@@ -6,10 +6,6 @@ Const END_COL As Long = 8
Const ERROR_COL As Long = 2
' ====== Function ======
Sub Z3_ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long)
Call Generic_Master_ClearRowData(ws, rowNum)
End Sub
Sub Z3_Import()
Call Generic_Master_Import(Me, 6)
End Sub