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