Update Z1 to use common functions

This commit is contained in:
updsv7
2026-04-13 18:16:57 +09:00
parent e282184fa5
commit aa1af0c409

View File

@@ -6,10 +6,7 @@ End Sub
Sub Z1_ImportMasterDetailData() Sub Z1_ImportMasterDetailData()
Dim filePath As String Dim filePath As String
Dim fileDialog As FileDialog
Dim wsTarget As Worksheet Dim wsTarget As Worksheet
Dim stream As Object
Dim textContent As String
Dim lines As Variant Dim lines As Variant
Dim i As Long Dim i As Long
Dim dataArray As Variant Dim dataArray As Variant
@@ -20,60 +17,24 @@ Sub Z1_ImportMasterDetailData()
Set wsTarget = Me Set wsTarget = Me
' === Step 1: Select CSV file === ' === Step 1: Select CSV file ===
Set fileDialog = Application.FileDialog(msoFileDialogFilePicker) filePath = SelectCSVFile()
With fileDialog If filePath = "" Then Exit Sub
.Filters.Clear
.Filters.Add "CSV Files", "*.csv"
.AllowMultiSelect = False
If .Show <> -1 Then Exit Sub
filePath = .SelectedItems(1)
End With
' === Step 2: Read CSV with Shift-JIS === ' === Step 2: Read CSV ===
Set stream = CreateObject("ADODB.Stream") lines = ReadCSVFile(filePath)
With stream
.Type = 2
.Charset = "shift_jis"
.Open
.LoadFromFile filePath
textContent = .ReadText
.Close
End With
lines = Split(textContent, vbLf) ' === Validate: check all rows have 7 columns ===
If Not ValidateCSVColumnCount(lines, 7) Then Exit Sub
' === First: validate all data rows have exactly 7 columns === ' === Clear data rows before import ===
Dim validRowCount As Long Call ClearDataRows(wsTarget, 7, 3)
Dim lineNum As Long
validRowCount = 0
For lineNum = 0 To UBound(lines)
If Trim(lines(lineNum)) <> "" Then
dataArray = Split(lines(lineNum), ",")
If UBound(dataArray) + 1 <> 7 Then
MsgBox "CSV line " & (lineNum + 1) & " has " & (UBound(dataArray) + 1) & " columns. Expected 7.", vbExclamation
Exit Sub
End If
validRowCount = validRowCount + 1
End If
Next lineNum
If validRowCount = 0 Then If UBound(lines) < 0 Then
MsgBox "No valid data in CSV.", vbExclamation
Exit Sub
End If
' === Clear all data rows before import ===
lastRow = wsTarget.Cells(wsTarget.Rows.Count, "C").End(xlUp).Row
If lastRow >= 7 Then
wsTarget.Range("A7:P" & lastRow).ClearContents
End If
If UBound(lines) < 1 Then
MsgBox "No data in CSV.", vbExclamation MsgBox "No data in CSV.", vbExclamation
Exit Sub Exit Sub
End If End If
' === Step 3: Collect CSV codes and data === ' === Collect CSV codes and data ===
Dim csvData As Object Dim csvData As Object
Set csvData = CreateObject("Scripting.Dictionary") Set csvData = CreateObject("Scripting.Dictionary")
@@ -81,7 +42,7 @@ Sub Z1_ImportMasterDetailData()
If Trim(lines(i)) = "" Then GoTo NextCsvLine If Trim(lines(i)) = "" Then GoTo NextCsvLine
dataArray = Split(lines(i), ",") dataArray = Split(lines(i), ",")
If UBound(dataArray) >= 0 Then If UBound(dataArray) >= 0 Then
code = Z1_CleanCSVField(CStr(dataArray(0))) code = CleanCSVField(CStr(dataArray(0)))
If code <> "" Then If code <> "" Then
' Use unique key: code + "_" + row index to avoid duplicate key error ' Use unique key: code + "_" + row index to avoid duplicate key error
csvData.Add code & "_" & i, dataArray csvData.Add code & "_" & i, dataArray
@@ -104,13 +65,13 @@ NextCsvLine:
dataArray = Split(lines(i), ",") dataArray = Split(lines(i), ",")
' CSV col1-7 -> C-I column (3-9) ' CSV col1-7 -> C-I column (3-9)
wsTarget.Cells(writeRow, 3).Value = Z1_CleanCSVField(CStr(dataArray(0))) wsTarget.Cells(writeRow, 3).Value = CleanCSVField(CStr(dataArray(0)))
wsTarget.Cells(writeRow, 4).Value = Z1_CleanCSVField(CStr(dataArray(1))) wsTarget.Cells(writeRow, 4).Value = CleanCSVField(CStr(dataArray(1)))
wsTarget.Cells(writeRow, 5).Value = Z1_CleanCSVField(CStr(dataArray(2))) wsTarget.Cells(writeRow, 5).Value = CleanCSVField(CStr(dataArray(2)))
wsTarget.Cells(writeRow, 6).Value = Z1_CleanCSVField(CStr(dataArray(3))) wsTarget.Cells(writeRow, 6).Value = CleanCSVField(CStr(dataArray(3)))
wsTarget.Cells(writeRow, 7).Value = Z1_CleanCSVField(CStr(dataArray(4))) wsTarget.Cells(writeRow, 7).Value = CleanCSVField(CStr(dataArray(4)))
wsTarget.Cells(writeRow, 8).Value = Z1_CleanCSVField(CStr(dataArray(5))) wsTarget.Cells(writeRow, 8).Value = CleanCSVField(CStr(dataArray(5)))
wsTarget.Cells(writeRow, 9).Value = Z1_CleanCSVField(CStr(dataArray(6))) wsTarget.Cells(writeRow, 9).Value = CleanCSVField(CStr(dataArray(6)))
writeRow = writeRow + 1 writeRow = writeRow + 1
NextLine: NextLine:
@@ -119,9 +80,9 @@ NextLine:
MsgBox writeRow - 7 & " rows imported.", vbInformation MsgBox writeRow - 7 & " rows imported.", vbInformation
End Sub End Sub
Function Z1_CleanCSVField(ByVal field As Variant) As String Function CleanCSVField(ByVal field As Variant) As String
If IsEmpty(field) Or IsNull(field) Then If IsEmpty(field) Or IsNull(field) Then
Z1_CleanCSVField = "" CleanCSVField = ""
Exit Function Exit Function
End If End If
@@ -134,7 +95,7 @@ Function Z1_CleanCSVField(ByVal field As Variant) As String
result = Replace(result, """""", """") result = Replace(result, """""", """")
End If End If
End If End If
Z1_CleanCSVField = result CleanCSVField = result
End Function End Function
Sub Z1_validateDetailData(ByVal ws As Worksheet, ByVal rowNum As Long) Sub Z1_validateDetailData(ByVal ws As Worksheet, ByVal rowNum As Long)
@@ -300,10 +261,10 @@ Sub Z1_ExportMasterDetailData()
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
' CSV col1 -> C column ' CSV col1 -> C column
csvContent = csvContent & Z1_CleanCSVField(ws.Cells(r, 3).Value) csvContent = csvContent & CleanCSVField(ws.Cells(r, 3).Value)
' CSV col2-11 -> I-R column ' CSV col2-11 -> I-R column
For j = 9 To 18 For j = 9 To 18
csvContent = csvContent & "," & Z1_CleanCSVField(ws.Cells(r, j).Value) csvContent = csvContent & "," & CleanCSVField(ws.Cells(r, j).Value)
Next j Next j
csvContent = csvContent & vbLf csvContent = csvContent & vbLf
End If End If