273 lines
7.9 KiB
Plaintext
273 lines
7.9 KiB
Plaintext
Sub Z1_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, 2).ClearContents ' Q column error info
|
|
End Sub
|
|
|
|
Sub Z1_ImportMasterDetailData()
|
|
Dim filePath As String
|
|
Dim wsTarget As Worksheet
|
|
Dim lines As Variant
|
|
Dim i As Long
|
|
Dim dataArray As Variant
|
|
Dim code As String
|
|
Dim lastRow As Long
|
|
Dim r As Long
|
|
' Target this worksheet
|
|
Set wsTarget = Me
|
|
|
|
' === Step 1: Select CSV file ===
|
|
filePath = SelectCSVFile()
|
|
If filePath = "" Then Exit Sub
|
|
|
|
' === Step 2: Read CSV ===
|
|
lines = ReadCSVFile(filePath)
|
|
|
|
' === Validate: check all rows have 7 columns ===
|
|
If Not ValidateCSVColumnCount(lines, 7) Then Exit Sub
|
|
|
|
' === Clear data rows before import ===
|
|
Call ClearDataRows(wsTarget, 7, 3)
|
|
|
|
If UBound(lines) < 0 Then
|
|
MsgBox "No data in CSV.", vbExclamation
|
|
Exit Sub
|
|
End If
|
|
|
|
' === Collect CSV codes and data ===
|
|
Dim csvData As Object
|
|
Set csvData = CreateObject("Scripting.Dictionary")
|
|
|
|
For i = 0 To UBound(lines)
|
|
If Trim(lines(i)) = "" Then GoTo NextCsvLine
|
|
dataArray = Split(lines(i), ",")
|
|
If UBound(dataArray) >= 0 Then
|
|
code = CleanCSVField(CStr(dataArray(0)))
|
|
If code <> "" Then
|
|
' Use unique key: code + "_" + row index to avoid duplicate key error
|
|
csvData.Add code & "_" & i, dataArray
|
|
End If
|
|
End If
|
|
NextCsvLine:
|
|
Next i
|
|
|
|
If csvData.Count = 0 Then
|
|
MsgBox "No valid code found.", vbExclamation
|
|
Exit Sub
|
|
End If
|
|
|
|
' === Step 6: Write CSV data to next available row ===
|
|
writeRow = 7
|
|
|
|
For i = 0 To UBound(lines)
|
|
If Trim(lines(i)) = "" Then GoTo NextLine
|
|
|
|
dataArray = Split(lines(i), ",")
|
|
|
|
' CSV col1-7 -> C-I column (3-9)
|
|
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:
|
|
Next i
|
|
|
|
MsgBox writeRow - 7 & " rows imported.", vbInformation
|
|
End Sub
|
|
|
|
Function CleanCSVField(ByVal field As Variant) As String
|
|
If IsEmpty(field) Or IsNull(field) Then
|
|
CleanCSVField = ""
|
|
Exit Function
|
|
End If
|
|
|
|
Dim result As String
|
|
result = Trim(CStr(field))
|
|
|
|
If Len(result) >= 2 Then
|
|
If Left(result, 1) = """" And Right(result, 1) = """" Then
|
|
result = Mid(result, 2, Len(result) - 2)
|
|
result = Replace(result, """""", """")
|
|
End If
|
|
End If
|
|
CleanCSVField = result
|
|
End Function
|
|
|
|
Sub Z1_validateDetailData(ByVal ws As Worksheet, ByVal rowNum As Long)
|
|
' Check C column - must be 3-digit alphanumeric, required
|
|
Dim cValue As String
|
|
cValue = Trim(ws.Cells(rowNum, 3).Value)
|
|
|
|
If cValue = "" Then
|
|
ws.Cells(rowNum, 2).Value = "C column is required"
|
|
Exit Sub
|
|
End If
|
|
|
|
If Len(cValue) <> 3 Then
|
|
ws.Cells(rowNum, 2).Value = "C column must be 3 characters"
|
|
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"
|
|
Exit Sub
|
|
End If
|
|
Next i
|
|
|
|
' Check D column - must be within 80 full-width characters, required
|
|
Dim dValue As String
|
|
dValue = Trim(ws.Cells(rowNum, 4).Value)
|
|
|
|
If dValue = "" Then
|
|
ws.Cells(rowNum, 2).Value = "D column is required"
|
|
Exit Sub
|
|
End If
|
|
|
|
If Len(dValue) > 80 Then
|
|
ws.Cells(rowNum, 2).Value = "D column must be within 80 characters"
|
|
Exit Sub
|
|
End If
|
|
|
|
' Check E column - must be within 80 full-width characters, required
|
|
Dim eValue As String
|
|
eValue = Trim(ws.Cells(rowNum, 5).Value)
|
|
|
|
If eValue = "" Then
|
|
ws.Cells(rowNum, 2).Value = "E column is required"
|
|
Exit Sub
|
|
End If
|
|
|
|
If Len(eValue) > 80 Then
|
|
ws.Cells(rowNum, 2).Value = "E column must be within 80 characters"
|
|
Exit Sub
|
|
End If
|
|
|
|
' Check F column - must be within 80 full-width characters, optional
|
|
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"
|
|
Exit Sub
|
|
End If
|
|
|
|
' Check G column - must be within 80 full-width characters, optional
|
|
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"
|
|
Exit Sub
|
|
End If
|
|
|
|
' Check I column - must be within 80 full-width characters, optional
|
|
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"
|
|
Exit Sub
|
|
End If
|
|
|
|
' Check H column - 1 digit, 0 or 1, optional
|
|
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"
|
|
Exit Sub
|
|
End If
|
|
If hValue <> "0" And hValue <> "1" Then
|
|
ws.Cells(rowNum, 2).Value = "H column must be 0 or 1"
|
|
Exit Sub
|
|
End If
|
|
End If
|
|
|
|
' Validation passed
|
|
ws.Cells(rowNum, 2).ClearContents
|
|
End Sub
|
|
|
|
|
|
' Button macro (Validate selected row)
|
|
Sub Z1_validateDetailDataButton()
|
|
Dim ws As Worksheet
|
|
Dim lastRow As Long
|
|
Dim r As Long
|
|
Dim errorCount As Long
|
|
|
|
Set ws = ActiveSheet
|
|
lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
|
|
|
|
If lastRow < 7 Then
|
|
MsgBox "No data found.", vbExclamation
|
|
Exit Sub
|
|
End If
|
|
|
|
errorCount = 0
|
|
For r = 7 To lastRow
|
|
Call Z1_validateDetailData(ws, r)
|
|
If Trim(ws.Cells(r, 2).Value) <> "" Then
|
|
errorCount = errorCount + 1
|
|
End If
|
|
Next r
|
|
|
|
MsgBox "Validation complete. Errors: " & errorCount & ", ", vbInformation
|
|
End Sub
|
|
|
|
Sub Z1_ExportMasterDetailData()
|
|
Dim ws As Worksheet
|
|
Set ws = ActiveSheet
|
|
|
|
' Get last data row
|
|
Dim lastDataRow As Long
|
|
lastDataRow = GetLastDataRow(ws, 3)
|
|
|
|
If lastDataRow < 7 Then
|
|
MsgBox "No data rows to output.", vbExclamation
|
|
Exit Sub
|
|
End If
|
|
|
|
' Get save path
|
|
Dim savePath As String
|
|
savePath = GetSaveCSVPath()
|
|
If savePath = "" Then Exit Sub
|
|
|
|
' Define columns to export (C, I-R = 3, 9-18)
|
|
Dim dataColumns(0 To 9) As Long
|
|
dataColumns(0) = 3
|
|
dataColumns(1) = 9
|
|
dataColumns(2) = 10
|
|
dataColumns(3) = 11
|
|
dataColumns(4) = 12
|
|
dataColumns(5) = 13
|
|
dataColumns(6) = 14
|
|
dataColumns(7) = 15
|
|
dataColumns(8) = 16
|
|
dataColumns(9) = 17
|
|
dataColumns(10) = 18
|
|
|
|
' Build CSV content (with header from row 5)
|
|
Dim csvContent As String
|
|
csvContent = BuildCSVContent(ws, 7, lastDataRow, dataColumns, 5)
|
|
|
|
' Count rows
|
|
Dim rowCount As Long
|
|
rowCount = 0
|
|
Dim r As Long
|
|
For r = 7 To lastDataRow
|
|
If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then
|
|
rowCount = rowCount + 1
|
|
End If
|
|
Next r
|
|
|
|
' Write file
|
|
Call WriteCSVFile(savePath, csvContent)
|
|
|
|
MsgBox "CSV export completed. Total data rows: " & rowCount, vbInformation
|
|
End Sub |