add master 222 223 224 bas
This commit is contained in:
updsv7
@@ -1,226 +1,258 @@
|
|||||||
Sub Z1_ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long)
|
' ====== (222) =======
|
||||||
ws.Range(ws.Cells(rowNum, 4), ws.Cells(rowNum, 15)).ClearContents
|
Sub Z1_ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long)
|
||||||
ws.Cells(rowNum, 2).ClearContents
|
ws.Range(ws.Cells(rowNum, 4), ws.Cells(rowNum, 15)).ClearContents
|
||||||
End Sub
|
ws.Cells(rowNum, 2).ClearContents
|
||||||
|
End Sub
|
||||||
Sub Z1_Import()
|
|
||||||
Dim filePath As String
|
Sub Z1_Import()
|
||||||
Dim wsTarget As Worksheet
|
Dim filePath As String
|
||||||
Dim lines As Variant
|
Dim wsTarget As Worksheet
|
||||||
Dim i As Long
|
Dim lines As Variant
|
||||||
Dim dataArray As Variant
|
Dim i As Long
|
||||||
Dim code As String
|
Dim dataArray As Variant
|
||||||
Dim writeRow As Long
|
Dim code As String
|
||||||
|
Dim writeRow As Long
|
||||||
Set wsTarget = Me
|
|
||||||
On Error GoTo ErrorHandler
|
Set wsTarget = Me
|
||||||
|
On Error GoTo ErrorHandler
|
||||||
' Step 1: Select CSV file
|
|
||||||
filePath = SelectCSVFile()
|
' Step 1: Select CSV file
|
||||||
If filePath = "" Then Exit Sub
|
filePath = SelectCSVFile()
|
||||||
|
If filePath = "" Then Exit Sub
|
||||||
' Step 2: Read CSV and return 2D array
|
|
||||||
lines = ReadCSVAs2DArrayStrict(filePath, 7, "utf-8")
|
' Step 2: Read CSV and return 2D array
|
||||||
|
lines = ReadCSVAs2DArrayStrict(filePath, 7, "utf-8")
|
||||||
' Step 3: Clear data rows
|
|
||||||
Call ClearDataRows(wsTarget, 7, 3)
|
' Step 3: Clear data rows
|
||||||
|
Call ClearDataRows(wsTarget, 7, 3)
|
||||||
' Step 4: Import data
|
|
||||||
writeRow = 7
|
' Step 4: Import data
|
||||||
For i = LBound(lines, 1) To UBound(lines, 1)
|
writeRow = 7
|
||||||
If Not isRowEmpty Then
|
For i = LBound(lines, 1) To UBound(lines, 1)
|
||||||
wsTarget.Cells(writeRow, 3).Value = CleanCSVField(CStr(lines(i, 1)))
|
If Not isRowEmpty Then
|
||||||
wsTarget.Cells(writeRow, 4).Value = CleanCSVField(CStr(lines(i, 2)))
|
wsTarget.Cells(writeRow, 3).Value = CleanCSVField(CStr(lines(i, 1)))
|
||||||
wsTarget.Cells(writeRow, 5).Value = CleanCSVField(CStr(lines(i, 3)))
|
wsTarget.Cells(writeRow, 4).Value = CleanCSVField(CStr(lines(i, 2)))
|
||||||
wsTarget.Cells(writeRow, 6).Value = CleanCSVField(CStr(lines(i, 4)))
|
wsTarget.Cells(writeRow, 5).Value = CleanCSVField(CStr(lines(i, 3)))
|
||||||
wsTarget.Cells(writeRow, 7).Value = CleanCSVField(CStr(lines(i, 5)))
|
wsTarget.Cells(writeRow, 6).Value = CleanCSVField(CStr(lines(i, 4)))
|
||||||
wsTarget.Cells(writeRow, 8).Value = CleanCSVField(CStr(lines(i, 6)))
|
wsTarget.Cells(writeRow, 7).Value = CleanCSVField(CStr(lines(i, 5)))
|
||||||
wsTarget.Cells(writeRow, 9).Value = CleanCSVField(CStr(lines(i, 7)))
|
wsTarget.Cells(writeRow, 8).Value = CleanCSVField(CStr(lines(i, 6)))
|
||||||
|
wsTarget.Cells(writeRow, 9).Value = CleanCSVField(CStr(lines(i, 7)))
|
||||||
writeRow = writeRow + 1
|
|
||||||
End If
|
writeRow = writeRow + 1
|
||||||
Next i
|
End If
|
||||||
|
Next i
|
||||||
MsgBox writeRow - 7 & " rows imported.", vbInformation
|
|
||||||
|
MsgBox writeRow - 7 & " rows imported.", vbInformation
|
||||||
Exit Sub
|
|
||||||
|
Exit Sub
|
||||||
ErrorHandler:
|
|
||||||
MsgBox "Import fails:" & vbCrLf & Err.Description, vbCritical
|
ErrorHandler:
|
||||||
End Sub
|
MsgBox "Import fails:" & vbCrLf & Err.Description, vbCritical
|
||||||
|
End Sub
|
||||||
Sub Z1_Export()
|
|
||||||
Dim ws As Worksheet
|
Sub Z1_Export()
|
||||||
Dim lastDataRow As Long
|
Dim ws As Worksheet
|
||||||
Dim savePath As String
|
Dim lastDataRow As Long
|
||||||
Dim r As Long
|
Dim savePath As String
|
||||||
Dim rowCount As Long
|
Dim r As Long
|
||||||
Dim dataArray() As Variant
|
Dim rowCount As Long
|
||||||
Dim dataIdx As Long
|
Dim dataArray() As Variant
|
||||||
Dim j As Long
|
Dim dataIdx As Long
|
||||||
|
Dim j As Long
|
||||||
Set ws = ActiveSheet
|
Dim errorCount As Long
|
||||||
|
|
||||||
lastDataRow = GetLastDataRow(ws, 3)
|
Set ws = ActiveSheet
|
||||||
|
|
||||||
If lastDataRow < 7 Then
|
lastDataRow = GetLastDataRow(ws, 3)
|
||||||
MsgBox "No data rows to output.", vbExclamation
|
|
||||||
Exit Sub
|
If lastDataRow < 7 Then
|
||||||
End If
|
MsgBox "No data rows to output.", vbExclamation
|
||||||
|
Exit Sub
|
||||||
savePath = GetSaveCSVPath()
|
End If
|
||||||
If savePath = "" Then Exit Sub
|
|
||||||
|
errorCount = 0
|
||||||
' Count valid rows first (C column non-empty from row 7 onward)
|
For r = 7 To lastDataRow
|
||||||
rowCount = 0
|
Call Z1_validate(ws, r)
|
||||||
For r = 7 To lastDataRow
|
If Trim(ws.Cells(r, 2).Value & "") <> "" Then
|
||||||
If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then
|
errorCount = errorCount + 1
|
||||||
rowCount = rowCount + 1
|
End If
|
||||||
End If
|
Next r
|
||||||
Next r
|
|
||||||
|
If errorCount > 0 Then
|
||||||
' If no data, exit
|
MsgBox "Validation failed. Found " & errorCount & " error(s). Please correct them before exporting.", vbCritical
|
||||||
If rowCount = 0 Then
|
Exit Sub
|
||||||
MsgBox "No data rows to output.", vbExclamation
|
End If
|
||||||
Exit Sub
|
|
||||||
End If
|
savePath = GetSaveCSVPath()
|
||||||
|
If savePath = "" Then Exit Sub
|
||||||
' Initialize 2D array: (1 To rowCount, 1 To 7) for columns C-I (3 to 9)
|
|
||||||
ReDim dataArray(1 To rowCount, 1 To 7)
|
' Count valid rows first (C column non-empty from row 7 onward)
|
||||||
|
rowCount = 0
|
||||||
' Fill the array
|
For r = 7 To lastDataRow
|
||||||
dataIdx = 0
|
If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then
|
||||||
For r = 7 To lastDataRow
|
rowCount = rowCount + 1
|
||||||
If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then
|
End If
|
||||||
dataIdx = dataIdx + 1
|
Next r
|
||||||
For j = 3 To 9
|
|
||||||
dataArray(dataIdx, j - 2) = ws.Cells(r, j).Value ' C->1, D->2, ..., I->7
|
' If no data, exit
|
||||||
Next j
|
If rowCount = 0 Then
|
||||||
End If
|
MsgBox "No data rows to output.", vbExclamation
|
||||||
Next r
|
Exit Sub
|
||||||
|
End If
|
||||||
' Write using the new array-based CSV writer
|
|
||||||
Call WriteCSVFromArray(savePath, dataArray, "utf-8", True)
|
' Initialize 2D array: (1 To rowCount, 1 To 7) for columns C-I (3 to 9)
|
||||||
|
ReDim dataArray(1 To rowCount, 1 To 7)
|
||||||
MsgBox "CSV export completed. Total data rows: " & rowCount, vbInformation
|
|
||||||
End Sub
|
' Fill the array
|
||||||
|
dataIdx = 0
|
||||||
Sub Z1_validate(ByVal ws As Worksheet, ByVal rowNum As Long)
|
For r = 7 To lastDataRow
|
||||||
Dim cValue As String
|
If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then
|
||||||
cValue = Trim(ws.Cells(rowNum, 3).Value)
|
dataIdx = dataIdx + 1
|
||||||
|
For j = 3 To 9
|
||||||
If cValue = "" Then
|
dataArray(dataIdx, j - 2) = ws.Cells(r, j).Value ' C->1, D->2, ..., I->7
|
||||||
ws.Cells(rowNum, 2).Value = "C column is required"
|
Next j
|
||||||
Exit Sub
|
End If
|
||||||
End If
|
Next r
|
||||||
|
|
||||||
If Len(cValue) <> 3 Then
|
' Write using the new array-based CSV writer
|
||||||
ws.Cells(rowNum, 2).Value = "C column must be 3 characters"
|
Call WriteCSVFromArray(savePath, dataArray, "utf-8", True)
|
||||||
Exit Sub
|
|
||||||
End If
|
MsgBox "CSV export completed. Total data rows: " & rowCount, vbInformation
|
||||||
|
End Sub
|
||||||
Dim i As Long
|
|
||||||
Dim ch As String
|
Sub Z1_validate(ByVal ws As Worksheet, ByVal rowNum As Long)
|
||||||
For i = 1 To 3
|
Dim cValue As String
|
||||||
ch = Mid(cValue, i, 1)
|
cValue = Trim(ws.Cells(rowNum, 3).Value)
|
||||||
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"
|
' clear C~I columns background color
|
||||||
Exit Sub
|
Dim clearRange As Range
|
||||||
End If
|
Set clearRange = ws.Range(ws.Cells(rowNum, 3), ws.Cells(rowNum, 9))
|
||||||
Next i
|
clearRange.Interior.ColorIndex = vbWhite
|
||||||
|
|
||||||
Dim dValue As String
|
If cValue = "" Then
|
||||||
dValue = Trim(ws.Cells(rowNum, 4).Value)
|
ws.Cells(rowNum, 2).Value = "C column is required"
|
||||||
If dValue = "" Then
|
ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
|
||||||
ws.Cells(rowNum, 2).Value = "D column is required"
|
Exit Sub
|
||||||
Exit Sub
|
End If
|
||||||
End If
|
|
||||||
If Len(dValue) > 80 Then
|
If Len(cValue) <> 3 Then
|
||||||
ws.Cells(rowNum, 2).Value = "D column must be within 80 characters"
|
ws.Cells(rowNum, 2).Value = "C column must be 3 characters"
|
||||||
Exit Sub
|
ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
|
||||||
End If
|
Exit Sub
|
||||||
|
End If
|
||||||
Dim eValue As String
|
|
||||||
eValue = Trim(ws.Cells(rowNum, 5).Value)
|
Dim i As Long
|
||||||
If eValue = "" Then
|
Dim ch As String
|
||||||
ws.Cells(rowNum, 2).Value = "E column is required"
|
For i = 1 To 3
|
||||||
Exit Sub
|
ch = Mid(cValue, i, 1)
|
||||||
End If
|
If Not ((ch >= "0" And ch <= "9") Or (ch >= "A" And ch <= "Z") Or (ch >= "a" And ch <= "z")) Then
|
||||||
If Len(eValue) > 80 Then
|
ws.Cells(rowNum, 2).Value = "C column must be alphanumeric"
|
||||||
ws.Cells(rowNum, 2).Value = "E column must be within 80 characters"
|
ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
|
||||||
Exit Sub
|
Exit Sub
|
||||||
End If
|
End If
|
||||||
|
Next i
|
||||||
Dim fValue As String
|
|
||||||
fValue = Trim(ws.Cells(rowNum, 6).Value)
|
Dim dValue As String
|
||||||
If fValue <> "" And Len(fValue) > 80 Then
|
dValue = Trim(ws.Cells(rowNum, 4).Value)
|
||||||
ws.Cells(rowNum, 2).Value = "F column must be within 80 characters"
|
If dValue = "" Then
|
||||||
Exit Sub
|
ws.Cells(rowNum, 2).Value = "D column is required"
|
||||||
End If
|
ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
Dim gValue As String
|
End If
|
||||||
gValue = Trim(ws.Cells(rowNum, 7).Value)
|
If Len(dValue) > 80 Then
|
||||||
If gValue <> "" And Len(gValue) > 80 Then
|
ws.Cells(rowNum, 2).Value = "D column must be within 80 characters"
|
||||||
ws.Cells(rowNum, 2).Value = "G column must be within 80 characters"
|
ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0)
|
||||||
Exit Sub
|
Exit Sub
|
||||||
End If
|
End If
|
||||||
|
|
||||||
Dim iValue As String
|
Dim eValue As String
|
||||||
iValue = Trim(ws.Cells(rowNum, 9).Value)
|
eValue = Trim(ws.Cells(rowNum, 5).Value)
|
||||||
If iValue <> "" And Len(iValue) > 80 Then
|
If eValue = "" Then
|
||||||
ws.Cells(rowNum, 2).Value = "I column must be within 80 characters"
|
ws.Cells(rowNum, 2).Value = "E column is required"
|
||||||
Exit Sub
|
ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0)
|
||||||
End If
|
Exit Sub
|
||||||
|
End If
|
||||||
Dim hValue As String
|
If Len(eValue) > 80 Then
|
||||||
hValue = Trim(ws.Cells(rowNum, 8).Value)
|
ws.Cells(rowNum, 2).Value = "E column must be within 80 characters"
|
||||||
If hValue <> "" Then
|
ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0)
|
||||||
If Len(hValue) <> 1 Then
|
Exit Sub
|
||||||
ws.Cells(rowNum, 2).Value = "H column must be 1 digit"
|
End If
|
||||||
Exit Sub
|
|
||||||
End If
|
Dim fValue As String
|
||||||
If hValue <> "0" And hValue <> "1" Then
|
fValue = Trim(ws.Cells(rowNum, 6).Value)
|
||||||
ws.Cells(rowNum, 2).Value = "H column must be 0 or 1"
|
If fValue <> "" And Len(fValue) > 80 Then
|
||||||
Exit Sub
|
ws.Cells(rowNum, 2).Value = "F column must be within 80 characters"
|
||||||
End If
|
ws.Cells(rowNum, 6).Interior.Color = RGB(255, 0, 0)
|
||||||
End If
|
Exit Sub
|
||||||
|
End If
|
||||||
ws.Cells(rowNum, 2).ClearContents
|
|
||||||
End Sub
|
Dim gValue As String
|
||||||
|
gValue = Trim(ws.Cells(rowNum, 7).Value)
|
||||||
Sub Z1_validateButton()
|
If gValue <> "" And Len(gValue) > 80 Then
|
||||||
Dim ws As Worksheet
|
ws.Cells(rowNum, 2).Value = "G column must be within 80 characters"
|
||||||
Dim lastRow As Long
|
ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0)
|
||||||
Dim r As Long
|
Exit Sub
|
||||||
Dim errorCount As Long
|
End If
|
||||||
|
|
||||||
Set ws = ActiveSheet
|
Dim iValue As String
|
||||||
lastRow = GetLastDataRow(ws, 3)
|
iValue = Trim(ws.Cells(rowNum, 9).Value)
|
||||||
|
If iValue <> "" And Len(iValue) > 80 Then
|
||||||
If lastRow < 7 Then
|
ws.Cells(rowNum, 2).Value = "I column must be within 80 characters"
|
||||||
MsgBox "No data found.", vbExclamation
|
ws.Cells(rowNum, 9).Interior.Color = RGB(255, 0, 0)
|
||||||
Exit Sub
|
Exit Sub
|
||||||
End If
|
End If
|
||||||
|
|
||||||
errorCount = 0
|
Dim hValue As String
|
||||||
For r = 7 To lastRow
|
hValue = Trim(ws.Cells(rowNum, 8).Value)
|
||||||
Call Z1_validate(ws, r)
|
If hValue <> "" Then
|
||||||
If Trim(ws.Cells(r, 2).Value) <> "" Then
|
If Len(hValue) <> 1 Then
|
||||||
errorCount = errorCount + 1
|
ws.Cells(rowNum, 2).Value = "H column must be 1 digit"
|
||||||
End If
|
ws.Cells(rowNum, 8).Interior.Color = RGB(255, 0, 0)
|
||||||
Next r
|
Exit Sub
|
||||||
|
End If
|
||||||
MsgBox "Validation complete. Errors: " & errorCount, vbInformation
|
If hValue <> "0" And hValue <> "1" Then
|
||||||
End Sub
|
ws.Cells(rowNum, 2).Value = "H column must be 0 or 1"
|
||||||
|
ws.Cells(rowNum, 8).Interior.Color = RGB(255, 0, 0)
|
||||||
Sub Z1_SortDataRowsByC()
|
Exit Sub
|
||||||
Call SortDataRows(3)
|
End If
|
||||||
End Sub
|
End If
|
||||||
|
|
||||||
Sub Z1_ToggleAutoFilter()
|
ws.Cells(rowNum, 2).ClearContents
|
||||||
Call ToggleAutoFilter(6)
|
End Sub
|
||||||
End Sub
|
|
||||||
|
Sub Z1_validateButton()
|
||||||
Sub Z1_AutoFitColumnWidth()
|
Dim ws As Worksheet
|
||||||
Call AutoFitColumnWidth()
|
Dim lastRow As Long
|
||||||
|
Dim r As Long
|
||||||
|
Dim errorCount As Long
|
||||||
|
|
||||||
|
Set ws = ActiveSheet
|
||||||
|
lastRow = GetLastDataRow(ws, 3)
|
||||||
|
|
||||||
|
If lastRow < 7 Then
|
||||||
|
MsgBox "No data found.", vbExclamation
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
errorCount = 0
|
||||||
|
For r = 7 To lastRow
|
||||||
|
Call Z1_validate(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_SortDataRowsByC()
|
||||||
|
Call SortDataRows(3)
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub Z1_ToggleAutoFilter()
|
||||||
|
Call ToggleAutoFilter(6)
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub Z1_AutoFitColumnWidth()
|
||||||
|
Call AutoFitColumnWidth()
|
||||||
End Sub
|
End Sub
|
||||||
258
src/thisWorkbook/Master_223.bas
Normal file
258
src/thisWorkbook/Master_223.bas
Normal file
@@ -0,0 +1,258 @@
|
|||||||
|
' ====== (223) =======
|
||||||
|
Sub Z2_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 Z2_Import()
|
||||||
|
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 writeRow As Long
|
||||||
|
|
||||||
|
Set wsTarget = Me
|
||||||
|
On Error GoTo ErrorHandler
|
||||||
|
|
||||||
|
' Step 1: Select CSV file
|
||||||
|
filePath = SelectCSVFile()
|
||||||
|
If filePath = "" Then Exit Sub
|
||||||
|
|
||||||
|
' Step 2: Read CSV and return 2D array
|
||||||
|
lines = ReadCSVAs2DArrayStrict(filePath, 7, "utf-8")
|
||||||
|
|
||||||
|
' Step 3: Clear data rows
|
||||||
|
Call ClearDataRows(wsTarget, 7, 3)
|
||||||
|
|
||||||
|
' Step 4: Import data
|
||||||
|
writeRow = 7
|
||||||
|
For i = LBound(lines, 1) To UBound(lines, 1)
|
||||||
|
If Not isRowEmpty Then
|
||||||
|
wsTarget.Cells(writeRow, 3).Value = CleanCSVField(CStr(lines(i, 1)))
|
||||||
|
wsTarget.Cells(writeRow, 4).Value = CleanCSVField(CStr(lines(i, 2)))
|
||||||
|
wsTarget.Cells(writeRow, 5).Value = CleanCSVField(CStr(lines(i, 3)))
|
||||||
|
wsTarget.Cells(writeRow, 6).Value = CleanCSVField(CStr(lines(i, 4)))
|
||||||
|
wsTarget.Cells(writeRow, 7).Value = CleanCSVField(CStr(lines(i, 5)))
|
||||||
|
wsTarget.Cells(writeRow, 8).Value = CleanCSVField(CStr(lines(i, 6)))
|
||||||
|
wsTarget.Cells(writeRow, 9).Value = CleanCSVField(CStr(lines(i, 7)))
|
||||||
|
|
||||||
|
writeRow = writeRow + 1
|
||||||
|
End If
|
||||||
|
Next i
|
||||||
|
|
||||||
|
MsgBox writeRow - 7 & " rows imported.", vbInformation
|
||||||
|
|
||||||
|
Exit Sub
|
||||||
|
|
||||||
|
ErrorHandler:
|
||||||
|
MsgBox "Import fails:" & vbCrLf & Err.Description, vbCritical
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub Z2_Export()
|
||||||
|
Dim ws As Worksheet
|
||||||
|
Dim lastDataRow As Long
|
||||||
|
Dim savePath As String
|
||||||
|
Dim r As Long
|
||||||
|
Dim rowCount As Long
|
||||||
|
Dim dataArray() As Variant
|
||||||
|
Dim dataIdx As Long
|
||||||
|
Dim j As Long
|
||||||
|
Dim errorCount As Long
|
||||||
|
|
||||||
|
Set ws = ActiveSheet
|
||||||
|
|
||||||
|
lastDataRow = GetLastDataRow(ws, 3)
|
||||||
|
|
||||||
|
If lastDataRow < 7 Then
|
||||||
|
MsgBox "No data rows to output.", vbExclamation
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
errorCount = 0
|
||||||
|
For r = 7 To lastDataRow
|
||||||
|
Call Z2_validate(ws, r)
|
||||||
|
If Trim(ws.Cells(r, 2).Value & "") <> "" Then
|
||||||
|
errorCount = errorCount + 1
|
||||||
|
End If
|
||||||
|
Next r
|
||||||
|
|
||||||
|
If errorCount > 0 Then
|
||||||
|
MsgBox "Validation failed. Found " & errorCount & " error(s). Please correct them before exporting.", vbCritical
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
savePath = GetSaveCSVPath()
|
||||||
|
If savePath = "" Then Exit Sub
|
||||||
|
|
||||||
|
' Count valid rows first (C column non-empty from row 7 onward)
|
||||||
|
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 no data, exit
|
||||||
|
If rowCount = 0 Then
|
||||||
|
MsgBox "No data rows to output.", vbExclamation
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
' Initialize 2D array: (1 To rowCount, 1 To 7) for columns C-I (3 to 9)
|
||||||
|
ReDim dataArray(1 To rowCount, 1 To 7)
|
||||||
|
|
||||||
|
' Fill the array
|
||||||
|
dataIdx = 0
|
||||||
|
For r = 7 To lastDataRow
|
||||||
|
If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then
|
||||||
|
dataIdx = dataIdx + 1
|
||||||
|
For j = 3 To 9
|
||||||
|
dataArray(dataIdx, j - 2) = ws.Cells(r, j).Value ' C->1, D->2, ..., I->7
|
||||||
|
Next j
|
||||||
|
End If
|
||||||
|
Next r
|
||||||
|
|
||||||
|
' Write using the new array-based CSV writer
|
||||||
|
Call WriteCSVFromArray(savePath, dataArray, "utf-8", True)
|
||||||
|
|
||||||
|
MsgBox "CSV export completed. Total data rows: " & rowCount, vbInformation
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub Z2_validate(ByVal ws As Worksheet, ByVal rowNum As Long)
|
||||||
|
Dim cValue As String
|
||||||
|
cValue = Trim(ws.Cells(rowNum, 3).Value)
|
||||||
|
|
||||||
|
' clear C~I columns background color
|
||||||
|
Dim clearRange As Range
|
||||||
|
Set clearRange = ws.Range(ws.Cells(rowNum, 3), ws.Cells(rowNum, 9))
|
||||||
|
clearRange.Interior.ColorIndex = vbWhite
|
||||||
|
|
||||||
|
If cValue = "" Then
|
||||||
|
ws.Cells(rowNum, 2).Value = "C column is required"
|
||||||
|
ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
If Len(cValue) <> 3 Then
|
||||||
|
ws.Cells(rowNum, 2).Value = "C column must be 3 characters"
|
||||||
|
ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
|
||||||
|
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"
|
||||||
|
ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
Next i
|
||||||
|
|
||||||
|
Dim dValue As String
|
||||||
|
dValue = Trim(ws.Cells(rowNum, 4).Value)
|
||||||
|
If dValue = "" Then
|
||||||
|
ws.Cells(rowNum, 2).Value = "D column is required"
|
||||||
|
ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
If Len(dValue) > 80 Then
|
||||||
|
ws.Cells(rowNum, 2).Value = "D column must be within 80 characters"
|
||||||
|
ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
Dim eValue As String
|
||||||
|
eValue = Trim(ws.Cells(rowNum, 5).Value)
|
||||||
|
If eValue = "" Then
|
||||||
|
ws.Cells(rowNum, 2).Value = "E column is required"
|
||||||
|
ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
If Len(eValue) > 80 Then
|
||||||
|
ws.Cells(rowNum, 2).Value = "E column must be within 80 characters"
|
||||||
|
ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
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"
|
||||||
|
ws.Cells(rowNum, 6).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
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"
|
||||||
|
ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
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"
|
||||||
|
ws.Cells(rowNum, 9).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
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"
|
||||||
|
ws.Cells(rowNum, 8).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
If hValue <> "0" And hValue <> "1" Then
|
||||||
|
ws.Cells(rowNum, 2).Value = "H column must be 0 or 1"
|
||||||
|
ws.Cells(rowNum, 8).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
End If
|
||||||
|
|
||||||
|
ws.Cells(rowNum, 2).ClearContents
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub Z2_validateButton()
|
||||||
|
Dim ws As Worksheet
|
||||||
|
Dim lastRow As Long
|
||||||
|
Dim r As Long
|
||||||
|
Dim errorCount As Long
|
||||||
|
|
||||||
|
Set ws = ActiveSheet
|
||||||
|
lastRow = GetLastDataRow(ws, 3)
|
||||||
|
|
||||||
|
If lastRow < 7 Then
|
||||||
|
MsgBox "No data found.", vbExclamation
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
errorCount = 0
|
||||||
|
For r = 7 To lastRow
|
||||||
|
Call Z2_validate(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 Z2_SortDataRowsByC()
|
||||||
|
Call SortDataRows(3)
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub Z2_ToggleAutoFilter()
|
||||||
|
Call ToggleAutoFilter(6)
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub Z2_AutoFitColumnWidth()
|
||||||
|
Call AutoFitColumnWidth()
|
||||||
|
End Sub
|
||||||
258
src/thisWorkbook/Master_224.bas
Normal file
258
src/thisWorkbook/Master_224.bas
Normal file
@@ -0,0 +1,258 @@
|
|||||||
|
' ====== (223) =======
|
||||||
|
Sub Z3_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 Z3_Import()
|
||||||
|
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 writeRow As Long
|
||||||
|
|
||||||
|
Set wsTarget = Me
|
||||||
|
On Error GoTo ErrorHandler
|
||||||
|
|
||||||
|
' Step 1: Select CSV file
|
||||||
|
filePath = SelectCSVFile()
|
||||||
|
If filePath = "" Then Exit Sub
|
||||||
|
|
||||||
|
' Step 2: Read CSV and return 2D array
|
||||||
|
lines = ReadCSVAs2DArrayStrict(filePath, 7, "utf-8")
|
||||||
|
|
||||||
|
' Step 3: Clear data rows
|
||||||
|
Call ClearDataRows(wsTarget, 7, 3)
|
||||||
|
|
||||||
|
' Step 4: Import data
|
||||||
|
writeRow = 7
|
||||||
|
For i = LBound(lines, 1) To UBound(lines, 1)
|
||||||
|
If Not isRowEmpty Then
|
||||||
|
wsTarget.Cells(writeRow, 3).Value = CleanCSVField(CStr(lines(i, 1)))
|
||||||
|
wsTarget.Cells(writeRow, 4).Value = CleanCSVField(CStr(lines(i, 2)))
|
||||||
|
wsTarget.Cells(writeRow, 5).Value = CleanCSVField(CStr(lines(i, 3)))
|
||||||
|
wsTarget.Cells(writeRow, 6).Value = CleanCSVField(CStr(lines(i, 4)))
|
||||||
|
wsTarget.Cells(writeRow, 7).Value = CleanCSVField(CStr(lines(i, 5)))
|
||||||
|
wsTarget.Cells(writeRow, 8).Value = CleanCSVField(CStr(lines(i, 6)))
|
||||||
|
wsTarget.Cells(writeRow, 9).Value = CleanCSVField(CStr(lines(i, 7)))
|
||||||
|
|
||||||
|
writeRow = writeRow + 1
|
||||||
|
End If
|
||||||
|
Next i
|
||||||
|
|
||||||
|
MsgBox writeRow - 7 & " rows imported.", vbInformation
|
||||||
|
|
||||||
|
Exit Sub
|
||||||
|
|
||||||
|
ErrorHandler:
|
||||||
|
MsgBox "Import fails:" & vbCrLf & Err.Description, vbCritical
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub Z3_Export()
|
||||||
|
Dim ws As Worksheet
|
||||||
|
Dim lastDataRow As Long
|
||||||
|
Dim savePath As String
|
||||||
|
Dim r As Long
|
||||||
|
Dim rowCount As Long
|
||||||
|
Dim dataArray() As Variant
|
||||||
|
Dim dataIdx As Long
|
||||||
|
Dim j As Long
|
||||||
|
Dim errorCount As Long
|
||||||
|
|
||||||
|
Set ws = ActiveSheet
|
||||||
|
|
||||||
|
lastDataRow = GetLastDataRow(ws, 3)
|
||||||
|
|
||||||
|
If lastDataRow < 7 Then
|
||||||
|
MsgBox "No data rows to output.", vbExclamation
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
errorCount = 0
|
||||||
|
For r = 7 To lastDataRow
|
||||||
|
Call Z3_validate(ws, r)
|
||||||
|
If Trim(ws.Cells(r, 2).Value & "") <> "" Then
|
||||||
|
errorCount = errorCount + 1
|
||||||
|
End If
|
||||||
|
Next r
|
||||||
|
|
||||||
|
If errorCount > 0 Then
|
||||||
|
MsgBox "Validation failed. Found " & errorCount & " error(s). Please correct them before exporting.", vbCritical
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
savePath = GetSaveCSVPath()
|
||||||
|
If savePath = "" Then Exit Sub
|
||||||
|
|
||||||
|
' Count valid rows first (C column non-empty from row 7 onward)
|
||||||
|
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 no data, exit
|
||||||
|
If rowCount = 0 Then
|
||||||
|
MsgBox "No data rows to output.", vbExclamation
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
' Initialize 2D array: (1 To rowCount, 1 To 7) for columns C-I (3 to 9)
|
||||||
|
ReDim dataArray(1 To rowCount, 1 To 7)
|
||||||
|
|
||||||
|
' Fill the array
|
||||||
|
dataIdx = 0
|
||||||
|
For r = 7 To lastDataRow
|
||||||
|
If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then
|
||||||
|
dataIdx = dataIdx + 1
|
||||||
|
For j = 3 To 9
|
||||||
|
dataArray(dataIdx, j - 2) = ws.Cells(r, j).Value ' C->1, D->2, ..., I->7
|
||||||
|
Next j
|
||||||
|
End If
|
||||||
|
Next r
|
||||||
|
|
||||||
|
' Write using the new array-based CSV writer
|
||||||
|
Call WriteCSVFromArray(savePath, dataArray, "utf-8", True)
|
||||||
|
|
||||||
|
MsgBox "CSV export completed. Total data rows: " & rowCount, vbInformation
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub Z3_validate(ByVal ws As Worksheet, ByVal rowNum As Long)
|
||||||
|
Dim cValue As String
|
||||||
|
cValue = Trim(ws.Cells(rowNum, 3).Value)
|
||||||
|
|
||||||
|
' clear C~I columns background color
|
||||||
|
Dim clearRange As Range
|
||||||
|
Set clearRange = ws.Range(ws.Cells(rowNum, 3), ws.Cells(rowNum, 9))
|
||||||
|
clearRange.Interior.ColorIndex = vbWhite
|
||||||
|
|
||||||
|
If cValue = "" Then
|
||||||
|
ws.Cells(rowNum, 2).Value = "C column is required"
|
||||||
|
ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
If Len(cValue) <> 3 Then
|
||||||
|
ws.Cells(rowNum, 2).Value = "C column must be 3 characters"
|
||||||
|
ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
|
||||||
|
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"
|
||||||
|
ws.Cells(rowNum, 3).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
Next i
|
||||||
|
|
||||||
|
Dim dValue As String
|
||||||
|
dValue = Trim(ws.Cells(rowNum, 4).Value)
|
||||||
|
If dValue = "" Then
|
||||||
|
ws.Cells(rowNum, 2).Value = "D column is required"
|
||||||
|
ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
If Len(dValue) > 80 Then
|
||||||
|
ws.Cells(rowNum, 2).Value = "D column must be within 80 characters"
|
||||||
|
ws.Cells(rowNum, 4).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
Dim eValue As String
|
||||||
|
eValue = Trim(ws.Cells(rowNum, 5).Value)
|
||||||
|
If eValue = "" Then
|
||||||
|
ws.Cells(rowNum, 2).Value = "E column is required"
|
||||||
|
ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
If Len(eValue) > 80 Then
|
||||||
|
ws.Cells(rowNum, 2).Value = "E column must be within 80 characters"
|
||||||
|
ws.Cells(rowNum, 5).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
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"
|
||||||
|
ws.Cells(rowNum, 6).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
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"
|
||||||
|
ws.Cells(rowNum, 7).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
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"
|
||||||
|
ws.Cells(rowNum, 9).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
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"
|
||||||
|
ws.Cells(rowNum, 8).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
If hValue <> "0" And hValue <> "1" Then
|
||||||
|
ws.Cells(rowNum, 2).Value = "H column must be 0 or 1"
|
||||||
|
ws.Cells(rowNum, 8).Interior.Color = RGB(255, 0, 0)
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
End If
|
||||||
|
|
||||||
|
ws.Cells(rowNum, 2).ClearContents
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub Z3_validateButton()
|
||||||
|
Dim ws As Worksheet
|
||||||
|
Dim lastRow As Long
|
||||||
|
Dim r As Long
|
||||||
|
Dim errorCount As Long
|
||||||
|
|
||||||
|
Set ws = ActiveSheet
|
||||||
|
lastRow = GetLastDataRow(ws, 3)
|
||||||
|
|
||||||
|
If lastRow < 7 Then
|
||||||
|
MsgBox "No data found.", vbExclamation
|
||||||
|
Exit Sub
|
||||||
|
End If
|
||||||
|
|
||||||
|
errorCount = 0
|
||||||
|
For r = 7 To lastRow
|
||||||
|
Call Z3_validate(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 Z3_SortDataRowsByC()
|
||||||
|
Call SortDataRows(3)
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub Z3_ToggleAutoFilter()
|
||||||
|
Call ToggleAutoFilter(6)
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Sub Z3_AutoFitColumnWidth()
|
||||||
|
Call AutoFitColumnWidth()
|
||||||
|
End Sub
|
||||||
Binary file not shown.
Reference in New Issue
Block a user