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

Fix common module and simplify Z1 export

Browse Source
This commit is contained in:
updsv7
2026-04-13 18:21:42 +09:00
parent 9338e4adbf
commit c9844a6cfe
2 changed files with 36 additions and 25 deletions
Download Patch File Download Diff File Expand all files Collapse all files

21
vba_code_common.txt
View File

@@ -159,7 +159,8 @@ End Sub
' dataColumns - array of column numbers to export
' Returns: CSV content string
' ============================================================
Function BuildCSVContent(ByVal ws As Worksheet, ByVal startRow As Long, ByVal endRow As Long, ByRef dataColumns() As Long, Optional ByVal headerRow As Long = 0) As String
Function BuildCSVContent(ByVal ws As Worksheet, ByVal startRow As Long, ByVal endRow As Long, ByVal startCol As Long, ByVal endCol As Long, Optional ByVal headerRow As Long = 0, Optional ByVal colStep As Long = 1) As String
' Simpler version: export continuous columns
Dim csvContent As String
Dim r As Long
Dim col As Long
@@ -167,11 +168,13 @@ Function BuildCSVContent(ByVal ws As Worksheet, ByVal startRow As Long, ByVal en
' Build header if specified
If headerRow > 0 Then
For col = LBound(dataColumns) To UBound(dataColumns)
If col = LBound(dataColumns) Then
csvContent = Trim(ws.Cells(headerRow, dataColumns(col)).Value)
firstCol = True
For col = startCol To endCol Step colStep
If firstCol Then
csvContent = Trim(ws.Cells(headerRow, col).Value)
firstCol = False
Else
csvContent = csvContent & "," & Trim(ws.Cells(headerRow, dataColumns(col)).Value)
csvContent = csvContent & "," & Trim(ws.Cells(headerRow, col).Value)
End If
Next col
csvContent = csvContent & vbLf
@@ -179,14 +182,14 @@ Function BuildCSVContent(ByVal ws As Worksheet, ByVal startRow As Long, ByVal en
' Build data rows
For r = startRow To endRow
If Len(Trim(ws.Cells(r, dataColumns(LBound(dataColumns))).Value & "")) > 0 Then
If Len(Trim(ws.Cells(r, startCol).Value & "")) > 0 Then
firstCol = True
For col = LBound(dataColumns) To UBound(dataColumns)
For col = startCol To endCol Step colStep
If firstCol Then
csvContent = csvContent & CleanCSVField(ws.Cells(r, dataColumns(col)).Value)
csvContent = csvContent & CleanCSVField(ws.Cells(r, col).Value)
firstCol = False
Else
csvContent = csvContent & "," & CleanCSVField(ws.Cells(r, dataColumns(col)).Value)
csvContent = csvContent & "," & CleanCSVField(ws.Cells(r, col).Value)
End If
Next col
csvContent = csvContent & vbLf

40
vba_code_kotsu_master.txt
View File

@@ -238,23 +238,31 @@ Sub Z1_ExportMasterDetailData()
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)
' Build header from row 5
Dim csvContent As String
csvContent = BuildCSVContent(ws, 7, lastDataRow, dataColumns, 5)
csvContent = Trim(ws.Cells(5, 3).Value)
Dim j As Long
For j = 9 To 18
csvContent = csvContent & "," & Trim(ws.Cells(5, j).Value)
Next j
csvContent = csvContent & vbLf
' Build data rows
Dim r As Long
For r = 7 To lastDataRow
If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then
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
' Trim trailing
Do While Right(csvContent, 1) = vbLf
csvContent = Left(csvContent, Len(csvContent) - 1)
Loop
' Count rows
Dim rowCount As Long