updsv7/vba
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

更新 vba_code_common.bas

Browse Source
This commit is contained in:
simple321vip
2026-04-13 09:49:53 +00:00
parent 97631524c0
commit 789d652940
1 changed files with 0 additions and 205 deletions
Download Patch File Download Diff File Expand all files Collapse all files

205
vba_code_common.bas
View File

@@ -129,208 +129,3 @@ Sub WriteCSVFile(ByVal filePath As String, ByVal content As String)
.Close
End With
End Sub
' ============================================================
' Z1 Specific Functions
' ============================================================
Sub Z1_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 Z1_ImportMasterDetailData()
Dim filePath As String
Dim wsTarget As Worksheet
Dim lines As Variant
Dim i As Long
Dim dataArray As Variant
Dim writeRow As Long
Set wsTarget = Me
filePath = SelectCSVFile()
If filePath = "" Then Exit Sub
lines = ReadCSVFile(filePath)
If Not ValidateCSVColumnCount(lines, 7) Then Exit Sub
Call ClearDataRows(wsTarget, 7, 3)
writeRow = 7
For i = 0 To UBound(lines)
If Trim(lines(i)) <> "" Then
dataArray = Split(lines(i), ",")
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
End If
Next i
MsgBox writeRow - 7 & " rows imported.", vbInformation
End Sub
Sub Z1_ExportMasterDetailData()
Dim ws As Worksheet
Dim lastDataRow As Long
Dim savePath As String
Dim csvContent As String
Dim r As Long
Dim j As Long
Dim rowCount As Long
Set ws = ActiveSheet
lastDataRow = GetLastDataRow(ws, 3)
If lastDataRow < 7 Then
MsgBox "No data rows to output.", vbExclamation
Exit Sub
End If
savePath = GetSaveCSVPath()
If savePath = "" Then Exit Sub
csvContent = Trim(ws.Cells(5, 3).Value)
For j = 9 To 18
csvContent = csvContent & "," & Trim(ws.Cells(5, j).Value)
Next j
csvContent = csvContent & vbLf
rowCount = 0
For r = 7 To lastDataRow
If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then
rowCount = rowCount + 1
csvContent = csvContent & CleanCSVField(ws.Cells(r, 3).Value)
For j = 9 To 18
csvContent = csvContent & "," & CleanCSVField(ws.Cells(r, j).Value)
Next j
csvContent = csvContent & vbLf
End If
Next r
Do While Right(csvContent, 1) = vbLf
csvContent = Left(csvContent, Len(csvContent) - 1)
Loop
Call WriteCSVFile(savePath, csvContent)
MsgBox "CSV export completed. Total data rows: " & rowCount, vbInformation
End Sub
Sub Z1_validateDetailData(ByVal ws As Worksheet, ByVal rowNum As Long)
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
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
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
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
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
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
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
ws.Cells(rowNum, 2).ClearContents
End Sub
Sub Z1_validateDetailDataButton()
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 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