update Master_M1_Kukan

This commit is contained in:
updsv7
2026-04-15 19:15:26 +09:00
parent 60c55a40c1
commit a2ea02f36d
3 changed files with 46 additions and 107 deletions

View File

@@ -2,25 +2,21 @@
' Generic Master Common Functions ' Generic Master Common Functions
' ============================================================ ' ============================================================
Sub Generic_Master_Import(ByVal ws As Worksheet, ByVal expectedColumnCount As Long) Sub Generic_Master_Import(ByVal ws As Worksheet, ByVal expectedColumnCount As Long)
Dim filePath As String
Dim lines As Variant
Dim i As Long
Dim writeRow As Long
On Error GoTo ErrorHandler On Error GoTo ErrorHandler
' Step 1: Select CSV file ' Step 1: Select CSV file
filePath = SelectCSVFile() Dim filePath As String: filePath = SelectCSVFile()
If filePath = "" Then Exit Sub If filePath = "" Then Exit Sub
' Step 2: Read CSV and return 2D array ' Step 2: Read CSV and return 2D array
lines = ReadCSVAs2DArrayStrict(filePath, expectedColumnCount, "utf-8") Dim lines As Variant: lines = ReadCSVAs2DArrayStrict(filePath, expectedColumnCount, "utf-8")
' Step 3: Clear data rows ' Step 3: Clear data rows
Call Generic_ClearDataRows(ws, 7, 3) Call Generic_ClearDataRows(ws, 7, 3)
' Step 4: Import data ' Step 4: Import data
writeRow = 7 Dim i As Long
Dim writeRow As Long: writeRow = 7
For i = LBound(lines, 1) To UBound(lines, 1) For i = LBound(lines, 1) To UBound(lines, 1)
If Not isRowEmpty Then If Not isRowEmpty Then
Dim colOffset As Long Dim colOffset As Long
@@ -41,18 +37,12 @@ ErrorHandler:
End Sub End Sub
Sub Generic_Master_Export(ByVal ws As Worksheet, ByVal expectedColumnCount As Long, ByVal lastDataRow As Long) Sub Generic_Master_Export(ByVal ws As Worksheet, ByVal expectedColumnCount As Long, ByVal lastDataRow As Long)
Dim savePath As String Dim savePath As String: savePath = GetSaveCSVPath()
Dim r As Long
Dim rowCount As Long
Dim dataArray() As Variant
Dim dataIdx As Long
Dim j As Long
savePath = GetSaveCSVPath()
If savePath = "" Then Exit Sub If savePath = "" Then Exit Sub
' Count valid rows first (C column non-empty from row 7 onward) ' Count valid rows first (C column non-empty from row 7 onward)
rowCount = 0 Dim rowCount As Long: rowCount = 0
Dim r As Long
For r = 7 To lastDataRow For r = 7 To lastDataRow
If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then
rowCount = rowCount + 1 rowCount = rowCount + 1
@@ -66,10 +56,12 @@ Sub Generic_Master_Export(ByVal ws As Worksheet, ByVal expectedColumnCount As Lo
End If End If
' Initialize 2D array: (1 To rowCount, 1 To expectedColumnCount) for columns C-I (3 to expectedColumnCount + 2) ' Initialize 2D array: (1 To rowCount, 1 To expectedColumnCount) for columns C-I (3 to expectedColumnCount + 2)
Dim dataArray() As Variant
ReDim dataArray(1 To rowCount, 1 To expectedColumnCount) ReDim dataArray(1 To rowCount, 1 To expectedColumnCount)
' Fill the array ' Fill the array
dataIdx = 0 Dim dataIdx As Long: dataIdx = 0
Dim j As Long
For r = 7 To lastDataRow For r = 7 To lastDataRow
If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then
dataIdx = dataIdx + 1 dataIdx = dataIdx + 1

View File

@@ -71,9 +71,15 @@ End Sub
Function GetM1CSVHeader(ByVal ws As Worksheet) As Variant Function GetM1CSVHeader(ByVal ws As Worksheet) As Variant
Dim headerArr(1 To 1, 1 To 12) As String Dim headerArr(1 To 1, 1 To 12) As String
Dim i As Long Dim i As Long
Dim cellValue As String
For i = 1 To 12 For i = 1 To 12
headerArr(1, i) = Trim(ws.Cells(5, i + 2).Value) ' i+2: 1→3(C), 12→14(N) cellValue = Trim(ws.Cells(5, i + 2).Value) ' i+2: 1→3(C), 12→14(N)
' Remove line breaks
cellValue = Replace(cellValue, vbLf, "")
cellValue = Replace(cellValue, vbCr, "")
cellValue = Replace(cellValue, vbCrLf, "")
headerArr(1, i) = cellValue
Next i Next i
GetM1CSVHeader = headerArr GetM1CSVHeader = headerArr
@@ -114,35 +120,6 @@ Private Sub Worksheet_Change(ByVal Target As Range)
End If End If
End Sub End Sub
Sub FillFromZ1(ByVal rowNum As Long)
Dim ws As Worksheet: Set ws = ActiveSheet
Dim code As String: code = Trim(ws.Cells(rowNum, 3).Value)
If code = "" Then
Call ClearRowData(ws, rowNum)
Exit Sub
End If
If z1Cache Is Nothing Then Call RefreshZ1Cache
If z1Cache Is Nothing Then Exit Sub
If z1Cache.Exists(code) Then
Dim vals As Variant: vals = z1Cache(code)
ws.Cells(rowNum, 4).Value = vals(0)
ws.Cells(rowNum, 5).Value = vals(1)
Else
Call ClearRowData(ws, rowNum)
End If
End Sub
Sub ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long)
' Clear columns D onwards
ws.Range(ws.Cells(rowNum, 4), ws.Cells(rowNum, 15)).ClearContents
ws.Cells(rowNum, 6).Validation.Delete
ws.Cells(rowNum, ERROR_COL).ClearContents ' Column Q - error info
End Sub
Sub M1_Import() Sub M1_Import()
Dim wsTarget As Worksheet: Set wsTarget = Me Dim wsTarget As Worksheet: Set wsTarget = Me
@@ -161,7 +138,9 @@ Sub M1_Import()
Exit Sub Exit Sub
End If End If
' === Step 3:Clear all data rows before import === ' === Step 3:Clear all data rows before import ===
Application.EnableEvents = False
Call ClearDataRows(wsTarget, START_COL, END_COL, 7) Call ClearDataRows(wsTarget, START_COL, END_COL, 7)
Application.EnableEvents = True
' === Step 3: Write CSV data to worksheet (forward order) === ' === Step 3: Write CSV data to worksheet (forward order) ===
Dim i As Long Dim i As Long
@@ -295,12 +274,10 @@ Sub M1_Export()
' === Step 1: Validate all rows before export === ' === Step 1: Validate all rows before export ===
Dim r As Long, errorCount As Long Dim r As Long, errorCount As Long
For r = 7 To lastDataRow For r = 7 To lastDataRow
If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then
Call validate(r, lastDataRow) Call validate(r, lastDataRow)
If Trim(ws.Cells(r, ERROR_COL).Value) <> "" Then If Trim(ws.Cells(r, ERROR_COL).Value) <> "" Then
errorCount = errorCount + 1 errorCount = errorCount + 1
End If End If
End If
Next r Next r
If errorCount > 0 Then If errorCount > 0 Then
@@ -313,60 +290,30 @@ Sub M1_Export()
savePath = GetSaveCSVPath() savePath = GetSaveCSVPath()
If savePath = "" Then Exit Sub If savePath = "" Then Exit Sub
' === Step 3: Get header from row 5 (C-N columns) === ' === 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 headerArr As Variant
headerArr = GetM1CSVHeader(ws) headerArr = GetM1CSVHeader(ws)
' === Step 4: Build data array (skip D, E, F columns) ===
Dim dataArr As Variant
Dim rowCount As Long
rowCount = 0
For r = 7 To lastDataRow
If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then
rowCount = rowCount + 1
End If
Next r
If rowCount = 0 Then
MsgBox "No data rows to output.", vbExclamation
Exit Sub
End If
ReDim dataArr(1 To rowCount, 1 To 12)
Dim dataRow As Long
dataRow = 0
For r = 7 To lastDataRow
If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then
dataRow = dataRow + 1
' CSV col1 -> C column
dataArr(dataRow, 1) = CleanCSVField(ws.Cells(r, 3).Value)
' CSV col2-12 -> G-N column (columns 7-14)
Dim j As Long
For j = 7 To 14
dataArr(dataRow, j - 6) = CleanCSVField(ws.Cells(r, j).Value)
Next j
End If
Next r
' === Step 5: Write to CSV (using common function) ===
Dim outputArr As Variant Dim outputArr As Variant
ReDim outputArr(1 To rowCount + 1, 1 To 12) ReDim outputArr(1 To rowCount + 1, 1 To 12)
' Copy header to first row ' Row 1: header
Dim colIdx As Long Dim colIdx As Long
For colIdx = 1 To 12 For colIdx = 1 To 12
outputArr(1, colIdx) = headerArr(1, colIdx) outputArr(1, colIdx) = headerArr(1, colIdx)
Next colIdx Next colIdx
' Copy data to remaining rows ' Rows 2+: data (C-N columns)
Dim dataR As Long Dim dataRow As Long: dataRow = 2
For dataR = 1 To rowCount For r = 7 To lastDataRow
For colIdx = 1 To 12 For colIdx = 1 To 12
outputArr(dataR + 1, colIdx) = dataArr(dataR, colIdx) outputArr(dataRow, colIdx) = CleanCSVField(ws.Cells(r, colIdx + 2).Value)
Next colIdx Next colIdx
Next dataR dataRow = dataRow + 1
Next r
On Error GoTo ExportError On Error GoTo ExportError
Call WriteCSVFromArray(savePath, outputArr, "shift_jis", False) Call WriteCSVFromArray(savePath, outputArr, "shift_jis", False)