Rename Z1_validateDetailData to Z1_validate, Z1_validateDetailDataButton to Z1_validateButton
This commit is contained in:
updsv7
@@ -1,92 +1,92 @@
|
|||||||
' ============================================================
|
' ============================================================
|
||||||
' Common Functions
|
' Common Functions
|
||||||
' ============================================================
|
' ============================================================
|
||||||
|
|
||||||
Function CleanCSVField(ByVal inputStr As String) As String
|
Function CleanCSVField(ByVal inputStr As String) As String
|
||||||
Dim s As String
|
Dim s As String
|
||||||
s = Trim(inputStr)
|
s = Trim(inputStr)
|
||||||
|
|
||||||
' calcute
|
' calcute
|
||||||
If Len(s) > 0 Then
|
If Len(s) > 0 Then
|
||||||
Select Case Left(s, 1)
|
Select Case Left(s, 1)
|
||||||
Case "=", "+", "-", "@"
|
Case "=", "+", "-", "@"
|
||||||
CleanCSVField = "'" & s
|
CleanCSVField = "'" & s
|
||||||
Exit Function
|
Exit Function
|
||||||
End Select
|
End Select
|
||||||
End If
|
End If
|
||||||
|
|
||||||
CleanCSVField = s
|
CleanCSVField = s
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
Function GetLastDataRow(ByVal ws As Worksheet, ByVal columnNum As Long) As Long
|
Function GetLastDataRow(ByVal ws As Worksheet, ByVal columnNum As Long) As Long
|
||||||
GetLastDataRow = ws.Cells(ws.Rows.Count, columnNum).End(xlUp).Row
|
GetLastDataRow = ws.Cells(ws.Rows.Count, columnNum).End(xlUp).Row
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
Sub ClearDataRows(ByVal ws As Worksheet, ByVal startRow As Long, ByVal columnNum As Long)
|
Sub ClearDataRows(ByVal ws As Worksheet, ByVal startRow As Long, ByVal columnNum As Long)
|
||||||
Dim lastRow As Long
|
Dim lastRow As Long
|
||||||
lastRow = ws.Cells(ws.Rows.Count, columnNum).End(xlUp).Row
|
lastRow = ws.Cells(ws.Rows.Count, columnNum).End(xlUp).Row
|
||||||
|
|
||||||
If lastRow >= startRow Then
|
If lastRow >= startRow Then
|
||||||
ws.Range(ws.Cells(startRow, 1), ws.Cells(lastRow, 20)).ClearContents
|
ws.Range(ws.Cells(startRow, 1), ws.Cells(lastRow, 20)).ClearContents
|
||||||
End If
|
End If
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
Sub SortDataRows(Optional ByVal sortColumn As Long = 3)
|
Sub SortDataRows(Optional ByVal sortColumn As Long = 3)
|
||||||
Dim ws As Worksheet
|
Dim ws As Worksheet
|
||||||
Dim lastRow As Long
|
Dim lastRow As Long
|
||||||
Dim startRow As Long
|
Dim startRow As Long
|
||||||
Dim sortOrder As Long
|
Dim sortOrder As Long
|
||||||
|
|
||||||
Set ws = ActiveSheet
|
Set ws = ActiveSheet
|
||||||
startRow = 7
|
startRow = 7
|
||||||
lastRow = GetLastDataRow(ws, sortColumn)
|
lastRow = GetLastDataRow(ws, sortColumn)
|
||||||
|
|
||||||
If lastRow < startRow Then
|
If lastRow < startRow Then
|
||||||
MsgBox "No data to sort.", vbExclamation
|
MsgBox "No data to sort.", vbExclamation
|
||||||
Exit Sub
|
Exit Sub
|
||||||
End If
|
End If
|
||||||
|
|
||||||
' Determine sort order based on first row's current state
|
' Determine sort order based on first row's current state
|
||||||
Dim currentFirst As String
|
Dim currentFirst As String
|
||||||
Dim nextFirst As String
|
Dim nextFirst As String
|
||||||
currentFirst = Trim(ws.Cells(startRow, sortColumn).Value)
|
currentFirst = Trim(ws.Cells(startRow, sortColumn).Value)
|
||||||
nextFirst = Trim(ws.Cells(startRow + 1, sortColumn).Value)
|
nextFirst = Trim(ws.Cells(startRow + 1, sortColumn).Value)
|
||||||
|
|
||||||
If currentFirst <> "" And nextFirst <> "" Then
|
If currentFirst <> "" And nextFirst <> "" Then
|
||||||
If currentFirst > nextFirst Then
|
If currentFirst > nextFirst Then
|
||||||
sortOrder = xlAscending
|
sortOrder = xlAscending
|
||||||
Else
|
Else
|
||||||
sortOrder = xlDescending
|
sortOrder = xlDescending
|
||||||
End If
|
End If
|
||||||
Else
|
Else
|
||||||
sortOrder = xlAscending
|
sortOrder = xlAscending
|
||||||
End If
|
End If
|
||||||
|
|
||||||
ws.Range(ws.Cells(startRow, 1), ws.Cells(lastRow, 20)).Sort _
|
ws.Range(ws.Cells(startRow, 1), ws.Cells(lastRow, 20)).Sort _
|
||||||
Key1:=ws.Cells(startRow, sortColumn), _
|
Key1:=ws.Cells(startRow, sortColumn), _
|
||||||
Order1:=sortOrder, _
|
Order1:=sortOrder, _
|
||||||
Header:=xlNo
|
Header:=xlNo
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
Sub ToggleAutoFilter(Optional ByVal filterRow As Long = 6)
|
Sub ToggleAutoFilter(Optional ByVal filterRow As Long = 6)
|
||||||
Dim ws As Worksheet
|
Dim ws As Worksheet
|
||||||
Set ws = ActiveSheet
|
Set ws = ActiveSheet
|
||||||
|
|
||||||
' Check if auto filter is already on
|
' Check if auto filter is already on
|
||||||
If ws.AutoFilterMode Then
|
If ws.AutoFilterMode Then
|
||||||
ws.AutoFilterMode = False
|
ws.AutoFilterMode = False
|
||||||
Else
|
Else
|
||||||
If filterRow >= 1 Then
|
If filterRow >= 1 Then
|
||||||
ws.Rows(filterRow).AutoFilter
|
ws.Rows(filterRow).AutoFilter
|
||||||
End If
|
End If
|
||||||
End If
|
End If
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
Sub AutoFitColumnWidth(Optional ByVal fitColumnStart As Long = 2, Optional ByVal fitColumnEnd As Long = 9)
|
Sub AutoFitColumnWidth(Optional ByVal fitColumnStart As Long = 2, Optional ByVal fitColumnEnd As Long = 9)
|
||||||
Dim ws As Worksheet
|
Dim ws As Worksheet
|
||||||
Set ws = ActiveSheet
|
Set ws = ActiveSheet
|
||||||
|
|
||||||
If fitColumnStart <= fitColumnEnd Then
|
If fitColumnStart <= fitColumnEnd Then
|
||||||
ws.Range(ws.Columns(fitColumnStart), ws.Columns(fitColumnEnd)).AutoFit
|
ws.Range(ws.Columns(fitColumnStart), ws.Columns(fitColumnEnd)).AutoFit
|
||||||
End If
|
End If
|
||||||
End Sub
|
End Sub
|
||||||
|
|||||||
@@ -1,168 +1,168 @@
|
|||||||
Function SelectCSVFile() As String
|
Function SelectCSVFile() As String
|
||||||
Dim fileDialog As FileDialog
|
Dim fileDialog As FileDialog
|
||||||
Set fileDialog = Application.FileDialog(msoFileDialogFilePicker)
|
Set fileDialog = Application.FileDialog(msoFileDialogFilePicker)
|
||||||
|
|
||||||
With fileDialog
|
With fileDialog
|
||||||
.Filters.Clear
|
.Filters.Clear
|
||||||
.Filters.Add "CSV Files", "*.csv"
|
.Filters.Add "CSV Files", "*.csv"
|
||||||
.AllowMultiSelect = False
|
.AllowMultiSelect = False
|
||||||
If .Show <> -1 Then
|
If .Show <> -1 Then
|
||||||
SelectCSVFile = ""
|
SelectCSVFile = ""
|
||||||
Exit Function
|
Exit Function
|
||||||
End If
|
End If
|
||||||
SelectCSVFile = .SelectedItems(1)
|
SelectCSVFile = .SelectedItems(1)
|
||||||
End With
|
End With
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
' Read a CSV file and return its content as a strict 2D array (1-based).
|
' Read a CSV file and return its content as a strict 2D array (1-based).
|
||||||
' All rows must have the same number of columns as the first row.
|
' All rows must have the same number of columns as the first row.
|
||||||
' If the file is empty and defaultColumnCount > 0, returns an empty 2D array with zero rows and defaultColumnCount columns.
|
' If the file is empty and defaultColumnCount > 0, returns an empty 2D array with zero rows and defaultColumnCount columns.
|
||||||
' Parameters:
|
' Parameters:
|
||||||
' filePath: Full path to the CSV file.
|
' filePath: Full path to the CSV file.
|
||||||
' charset: Text encoding (e.g., "cp932", "utf-8").
|
' charset: Text encoding (e.g., "cp932", "utf-8").
|
||||||
' defaultColumnCount: Optional. Used only if CSV has no rows. Must be >= 0.
|
' defaultColumnCount: Optional. Used only if CSV has no rows. Must be >= 0.
|
||||||
Function ReadCSVAs2DArrayStrict( _
|
Function ReadCSVAs2DArrayStrict( _
|
||||||
ByVal filePath As String, _
|
ByVal filePath As String, _
|
||||||
ByVal expectedColumnCount As Long, _
|
ByVal expectedColumnCount As Long, _
|
||||||
Optional ByVal charset As String = "cp932", _
|
Optional ByVal charset As String = "cp932", _
|
||||||
Optional ByVal hasHeader As Boolean = False) As Variant
|
Optional ByVal hasHeader As Boolean = False) As Variant
|
||||||
|
|
||||||
' === validate expectedColumnCount ===
|
' === validate expectedColumnCount ===
|
||||||
If expectedColumnCount <= 0 Then
|
If expectedColumnCount <= 0 Then
|
||||||
Err.Raise 5001, , "expectedColumnCount must be >= 1."
|
Err.Raise 5001, , "expectedColumnCount must be >= 1."
|
||||||
End If
|
End If
|
||||||
|
|
||||||
If Dir(filePath) = "" Then
|
If Dir(filePath) = "" Then
|
||||||
Err.Raise 5002, , "File not found: " & filePath
|
Err.Raise 5002, , "File not found: " & filePath
|
||||||
End If
|
End If
|
||||||
|
|
||||||
' === read csv file ===
|
' === read csv file ===
|
||||||
Dim stream As Object
|
Dim stream As Object
|
||||||
Set stream = CreateObject("ADODB.Stream")
|
Set stream = CreateObject("ADODB.Stream")
|
||||||
With stream
|
With stream
|
||||||
.Type = 2 ' adTypeText
|
.Type = 2 ' adTypeText
|
||||||
.charset = charset
|
.charset = charset
|
||||||
.Open
|
.Open
|
||||||
.LoadFromFile filePath
|
.LoadFromFile filePath
|
||||||
Dim textContent As String
|
Dim textContent As String
|
||||||
textContent = .ReadText
|
textContent = .ReadText
|
||||||
.Close
|
.Close
|
||||||
End With
|
End With
|
||||||
|
|
||||||
' === stardand ===
|
' === stardand ===
|
||||||
textContent = Replace(textContent, vbCrLf, vbLf)
|
textContent = Replace(textContent, vbCrLf, vbLf)
|
||||||
textContent = Replace(textContent, vbCr, vbLf)
|
textContent = Replace(textContent, vbCr, vbLf)
|
||||||
|
|
||||||
' === transfer into collection ===
|
' === transfer into collection ===
|
||||||
Dim lines As Collection
|
Dim lines As Collection
|
||||||
Set lines = ParseCSVLines(textContent)
|
Set lines = ParseCSVLines(textContent)
|
||||||
|
|
||||||
' === validate empty ===
|
' === validate empty ===
|
||||||
If lines.Count = 0 Then
|
If lines.Count = 0 Then
|
||||||
Err.Raise 5003, , "CSV file is empty."
|
Err.Raise 5003, , "CSV file is empty."
|
||||||
End If
|
End If
|
||||||
|
|
||||||
' === loop the row, validate column count ===
|
' === loop the row, validate column count ===
|
||||||
Dim i As Long
|
Dim i As Long
|
||||||
For i = 1 To lines.Count
|
For i = 1 To lines.Count
|
||||||
Dim rowArr As Variant
|
Dim rowArr As Variant
|
||||||
rowArr = lines(i)
|
rowArr = lines(i)
|
||||||
Dim actualCols As Long
|
Dim actualCols As Long
|
||||||
actualCols = UBound(rowArr) - LBound(rowArr) + 1
|
actualCols = UBound(rowArr) - LBound(rowArr) + 1
|
||||||
|
|
||||||
If actualCols <> expectedColumnCount Then
|
If actualCols <> expectedColumnCount Then
|
||||||
Err.Raise 5004, , "Row " & i & ": Expected " & expectedColumnCount & " columns, got " & actualCols & "."
|
Err.Raise 5004, , "Row " & i & ": Expected " & expectedColumnCount & " columns, got " & actualCols & "."
|
||||||
End If
|
End If
|
||||||
Next i
|
Next i
|
||||||
|
|
||||||
Dim result As Variant
|
Dim result As Variant
|
||||||
ReDim result(1 To lines.Count, 1 To expectedColumnCount)
|
ReDim result(1 To lines.Count, 1 To expectedColumnCount)
|
||||||
|
|
||||||
For i = 1 To lines.Count
|
For i = 1 To lines.Count
|
||||||
rowArr = lines(i)
|
rowArr = lines(i)
|
||||||
Dim j As Long
|
Dim j As Long
|
||||||
For j = LBound(rowArr) To UBound(rowArr)
|
For j = LBound(rowArr) To UBound(rowArr)
|
||||||
result(i, j - LBound(rowArr) + 1) = rowArr(j)
|
result(i, j - LBound(rowArr) + 1) = rowArr(j)
|
||||||
Next j
|
Next j
|
||||||
Next i
|
Next i
|
||||||
|
|
||||||
ReadCSVAs2DArrayStrict = result
|
ReadCSVAs2DArrayStrict = result
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
' Helper function: Parse CSV text into collection of string arrays (zero-based per row)
|
' Helper function: Parse CSV text into collection of string arrays (zero-based per row)
|
||||||
Private Function ParseCSVLines(ByVal csvText As String) As Collection
|
Private Function ParseCSVLines(ByVal csvText As String) As Collection
|
||||||
Set ParseCSVLines = New Collection
|
Set ParseCSVLines = New Collection
|
||||||
Dim length As Long: length = Len(csvText)
|
Dim length As Long: length = Len(csvText)
|
||||||
If length = 0 Then Exit Function
|
If length = 0 Then Exit Function
|
||||||
|
|
||||||
Dim i As Long: i = 1
|
Dim i As Long: i = 1
|
||||||
Dim currentField As String
|
Dim currentField As String
|
||||||
Dim currentRow As Collection: Set currentRow = New Collection
|
Dim currentRow As Collection: Set currentRow = New Collection
|
||||||
Dim inQuotes As Boolean
|
Dim inQuotes As Boolean
|
||||||
Dim c As String
|
Dim c As String
|
||||||
|
|
||||||
Do While i <= length
|
Do While i <= length
|
||||||
c = Mid$(csvText, i, 1)
|
c = Mid$(csvText, i, 1)
|
||||||
Select Case c
|
Select Case c
|
||||||
Case """"
|
Case """"
|
||||||
If inQuotes Then
|
If inQuotes Then
|
||||||
If i < length And Mid$(csvText, i + 1, 1) = """" Then
|
If i < length And Mid$(csvText, i + 1, 1) = """" Then
|
||||||
currentField = currentField & """"
|
currentField = currentField & """"
|
||||||
i = i + 2
|
i = i + 2
|
||||||
Else
|
Else
|
||||||
inQuotes = False
|
inQuotes = False
|
||||||
i = i + 1
|
i = i + 1
|
||||||
End If
|
End If
|
||||||
Else
|
Else
|
||||||
inQuotes = True
|
inQuotes = True
|
||||||
i = i + 1
|
i = i + 1
|
||||||
End If
|
End If
|
||||||
Case ","
|
Case ","
|
||||||
If inQuotes Then
|
If inQuotes Then
|
||||||
currentField = currentField & c
|
currentField = currentField & c
|
||||||
i = i + 1
|
i = i + 1
|
||||||
Else
|
Else
|
||||||
currentRow.Add currentField
|
currentRow.Add currentField
|
||||||
currentField = ""
|
currentField = ""
|
||||||
i = i + 1
|
i = i + 1
|
||||||
End If
|
End If
|
||||||
Case vbLf
|
Case vbLf
|
||||||
If inQuotes Then
|
If inQuotes Then
|
||||||
currentField = currentField & c
|
currentField = currentField & c
|
||||||
i = i + 1
|
i = i + 1
|
||||||
Else
|
Else
|
||||||
currentRow.Add currentField
|
currentRow.Add currentField
|
||||||
Dim arr() As String
|
Dim arr() As String
|
||||||
If currentRow.Count > 0 Then
|
If currentRow.Count > 0 Then
|
||||||
ReDim arr(0 To currentRow.Count - 1)
|
ReDim arr(0 To currentRow.Count - 1)
|
||||||
Dim k As Long
|
Dim k As Long
|
||||||
For k = 1 To currentRow.Count
|
For k = 1 To currentRow.Count
|
||||||
arr(k - 1) = currentRow(k)
|
arr(k - 1) = currentRow(k)
|
||||||
Next k
|
Next k
|
||||||
End If
|
End If
|
||||||
ParseCSVLines.Add arr
|
ParseCSVLines.Add arr
|
||||||
Set currentRow = New Collection
|
Set currentRow = New Collection
|
||||||
currentField = ""
|
currentField = ""
|
||||||
inQuotes = False
|
inQuotes = False
|
||||||
i = i + 1
|
i = i + 1
|
||||||
End If
|
End If
|
||||||
Case Else
|
Case Else
|
||||||
currentField = currentField & c
|
currentField = currentField & c
|
||||||
i = i + 1
|
i = i + 1
|
||||||
End Select
|
End Select
|
||||||
Loop
|
Loop
|
||||||
|
|
||||||
' Handle last row without trailing newline
|
' Handle last row without trailing newline
|
||||||
If currentField <> "" Or currentRow.Count > 0 Then
|
If currentField <> "" Or currentRow.Count > 0 Then
|
||||||
currentRow.Add currentField
|
currentRow.Add currentField
|
||||||
Dim lastArr() As String
|
Dim lastArr() As String
|
||||||
If currentRow.Count > 0 Then
|
If currentRow.Count > 0 Then
|
||||||
ReDim lastArr(0 To currentRow.Count - 1)
|
ReDim lastArr(0 To currentRow.Count - 1)
|
||||||
Dim m As Long
|
Dim m As Long
|
||||||
For m = 1 To currentRow.Count
|
For m = 1 To currentRow.Count
|
||||||
lastArr(m - 1) = currentRow(m)
|
lastArr(m - 1) = currentRow(m)
|
||||||
Next m
|
Next m
|
||||||
End If
|
End If
|
||||||
ParseCSVLines.Add lastArr
|
ParseCSVLines.Add lastArr
|
||||||
End If
|
End If
|
||||||
End Function
|
End Function
|
||||||
@@ -1,138 +1,138 @@
|
|||||||
Function GetSaveCSVPath(Optional ByVal defaultName As String = "") As String
|
Function GetSaveCSVPath(Optional ByVal defaultName As String = "") As String
|
||||||
Dim savePath As String
|
Dim savePath As String
|
||||||
savePath = Application.GetSaveAsFilename( _
|
savePath = Application.GetSaveAsFilename( _
|
||||||
FileFilter:="CSV Files (*.csv), *.csv", _
|
FileFilter:="CSV Files (*.csv), *.csv", _
|
||||||
Title:="Save CSV", _
|
Title:="Save CSV", _
|
||||||
InitialFileName:=defaultName)
|
InitialFileName:=defaultName)
|
||||||
|
|
||||||
If savePath = "False" Or savePath = "" Then
|
If savePath = "False" Or savePath = "" Then
|
||||||
GetSaveCSVPath = ""
|
GetSaveCSVPath = ""
|
||||||
Exit Function
|
Exit Function
|
||||||
End If
|
End If
|
||||||
|
|
||||||
If InStr(1, savePath, ".csv", vbTextCompare) = 0 Then
|
If InStr(1, savePath, ".csv", vbTextCompare) = 0 Then
|
||||||
savePath = savePath & ".csv"
|
savePath = savePath & ".csv"
|
||||||
End If
|
End If
|
||||||
|
|
||||||
GetSaveCSVPath = savePath
|
GetSaveCSVPath = savePath
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
' Writes a 2D array to a CSV file
|
' Writes a 2D array to a CSV file
|
||||||
Sub WriteCSVFromArray( _
|
Sub WriteCSVFromArray( _
|
||||||
ByVal filePath As String, _
|
ByVal filePath As String, _
|
||||||
ByVal data As Variant, _
|
ByVal data As Variant, _
|
||||||
Optional ByVal Charset As String = "shift_jis", _
|
Optional ByVal Charset As String = "shift_jis", _
|
||||||
Optional ByVal alwaysQuote As Boolean = False _
|
Optional ByVal alwaysQuote As Boolean = False _
|
||||||
)
|
)
|
||||||
' === Input validation ===
|
' === Input validation ===
|
||||||
If Not IsArray(data) Then
|
If Not IsArray(data) Then
|
||||||
Err.Raise 513, , "Input 'data' must be an array."
|
Err.Raise 513, , "Input 'data' must be an array."
|
||||||
End If
|
End If
|
||||||
|
|
||||||
Dim numDims As Long
|
Dim numDims As Long
|
||||||
On Error Resume Next
|
On Error Resume Next
|
||||||
numDims = ArrayDimensions(data)
|
numDims = ArrayDimensions(data)
|
||||||
On Error GoTo 0
|
On Error GoTo 0
|
||||||
If numDims <> 2 Then
|
If numDims <> 2 Then
|
||||||
Err.Raise 514, , "Input array must be 2-dimensional."
|
Err.Raise 514, , "Input array must be 2-dimensional."
|
||||||
End If
|
End If
|
||||||
|
|
||||||
Dim rows As Long, cols As Long
|
Dim rows As Long, cols As Long
|
||||||
rows = UBound(data, 1) - LBound(data, 1) + 1
|
rows = UBound(data, 1) - LBound(data, 1) + 1
|
||||||
cols = UBound(data, 2) - LBound(data, 2) + 1
|
cols = UBound(data, 2) - LBound(data, 2) + 1
|
||||||
|
|
||||||
If rows = 0 Or cols = 0 Then Exit Sub ' Empty array, exit early
|
If rows = 0 Or cols = 0 Then Exit Sub ' Empty array, exit early
|
||||||
|
|
||||||
' === Build CSV content ===
|
' === Build CSV content ===
|
||||||
Dim outputLines As Collection
|
Dim outputLines As Collection
|
||||||
Set outputLines = New Collection
|
Set outputLines = New Collection
|
||||||
|
|
||||||
Dim i As Long, j As Long
|
Dim i As Long, j As Long
|
||||||
Dim rowStr As String
|
Dim rowStr As String
|
||||||
Dim field As String
|
Dim field As String
|
||||||
Dim needsQuote As Boolean
|
Dim needsQuote As Boolean
|
||||||
|
|
||||||
For i = LBound(data, 1) To UBound(data, 1)
|
For i = LBound(data, 1) To UBound(data, 1)
|
||||||
Dim fields As Variant
|
Dim fields As Variant
|
||||||
ReDim fields(1 To cols)
|
ReDim fields(1 To cols)
|
||||||
|
|
||||||
For j = LBound(data, 2) To UBound(data, 2)
|
For j = LBound(data, 2) To UBound(data, 2)
|
||||||
' Safely convert variant to string
|
' Safely convert variant to string
|
||||||
field = SafeToString(data(i, j))
|
field = SafeToString(data(i, j))
|
||||||
|
|
||||||
' Determine if the field needs quoting (per RFC 4180)
|
' Determine if the field needs quoting (per RFC 4180)
|
||||||
needsQuote = alwaysQuote Or (InStr(field, """") > 0) Or _
|
needsQuote = alwaysQuote Or (InStr(field, """") > 0) Or _
|
||||||
(InStr(field, ",") > 0) Or _
|
(InStr(field, ",") > 0) Or _
|
||||||
(InStr(field, vbLf) > 0) Or _
|
(InStr(field, vbLf) > 0) Or _
|
||||||
(InStr(field, vbCrLf) > 0) Or _
|
(InStr(field, vbCrLf) > 0) Or _
|
||||||
(InStr(field, vbCr) > 0) Or _
|
(InStr(field, vbCr) > 0) Or _
|
||||||
(Left(field, 1) = " " Or Right(field, 1) = " ")
|
(Left(field, 1) = " " Or Right(field, 1) = " ")
|
||||||
|
|
||||||
If needsQuote Then
|
If needsQuote Then
|
||||||
' Escape double quotes: "" represents a single "
|
' Escape double quotes: "" represents a single "
|
||||||
field = """" & Replace(field, """", """""") & """"
|
field = """" & Replace(field, """", """""") & """"
|
||||||
End If
|
End If
|
||||||
|
|
||||||
fields(j - LBound(data, 2) + 1) = field
|
fields(j - LBound(data, 2) + 1) = field
|
||||||
Next j
|
Next j
|
||||||
|
|
||||||
rowStr = Join(fields, ",")
|
rowStr = Join(fields, ",")
|
||||||
outputLines.Add rowStr
|
outputLines.Add rowStr
|
||||||
Next i
|
Next i
|
||||||
|
|
||||||
' Concatenate all lines
|
' Concatenate all lines
|
||||||
Dim finalContent As String
|
Dim finalContent As String
|
||||||
finalContent = Join(CollectionToArray(outputLines), vbCrLf)
|
finalContent = Join(CollectionToArray(outputLines), vbCrLf)
|
||||||
|
|
||||||
' === Write to file ===
|
' === Write to file ===
|
||||||
Dim stream As Object
|
Dim stream As Object
|
||||||
Set stream = CreateObject("ADODB.Stream")
|
Set stream = CreateObject("ADODB.Stream")
|
||||||
With stream
|
With stream
|
||||||
.Type = 2 ' adTypeText
|
.Type = 2 ' adTypeText
|
||||||
.Charset = Charset
|
.Charset = Charset
|
||||||
.Open
|
.Open
|
||||||
.WriteText finalContent, 0 ' adWriteChar
|
.WriteText finalContent, 0 ' adWriteChar
|
||||||
.SaveToFile filePath, 2 ' adSaveCreateOverWrite
|
.SaveToFile filePath, 2 ' adSaveCreateOverWrite
|
||||||
.Close
|
.Close
|
||||||
End With
|
End With
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
' Helper function: safely convert any Variant to a string
|
' Helper function: safely convert any Variant to a string
|
||||||
Private Function SafeToString(ByVal v As Variant) As String
|
Private Function SafeToString(ByVal v As Variant) As String
|
||||||
On Error Resume Next
|
On Error Resume Next
|
||||||
If IsNull(v) Or IsEmpty(v) Then
|
If IsNull(v) Or IsEmpty(v) Then
|
||||||
SafeToString = ""
|
SafeToString = ""
|
||||||
Else
|
Else
|
||||||
SafeToString = CStr(v)
|
SafeToString = CStr(v)
|
||||||
End If
|
End If
|
||||||
On Error GoTo 0
|
On Error GoTo 0
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
' Helper function: get the number of dimensions of an array (1, 2, ...)
|
' Helper function: get the number of dimensions of an array (1, 2, ...)
|
||||||
Private Function ArrayDimensions(arr As Variant) As Long
|
Private Function ArrayDimensions(arr As Variant) As Long
|
||||||
Dim dimCount As Long
|
Dim dimCount As Long
|
||||||
On Error GoTo ExitPoint
|
On Error GoTo ExitPoint
|
||||||
Do
|
Do
|
||||||
dimCount = dimCount + 1
|
dimCount = dimCount + 1
|
||||||
Dim tmp As Long
|
Dim tmp As Long
|
||||||
tmp = UBound(arr, dimCount)
|
tmp = UBound(arr, dimCount)
|
||||||
Loop
|
Loop
|
||||||
ExitPoint:
|
ExitPoint:
|
||||||
ArrayDimensions = dimCount - 1
|
ArrayDimensions = dimCount - 1
|
||||||
End Function
|
End Function
|
||||||
|
|
||||||
' Helper function: convert a Collection to a 1D array (for use with Join)
|
' Helper function: convert a Collection to a 1D array (for use with Join)
|
||||||
Private Function CollectionToArray(col As Collection) As Variant
|
Private Function CollectionToArray(col As Collection) As Variant
|
||||||
If col.Count = 0 Then
|
If col.Count = 0 Then
|
||||||
CollectionToArray = Array()
|
CollectionToArray = Array()
|
||||||
Exit Function
|
Exit Function
|
||||||
End If
|
End If
|
||||||
|
|
||||||
Dim arr() As String
|
Dim arr() As String
|
||||||
ReDim arr(1 To col.Count)
|
ReDim arr(1 To col.Count)
|
||||||
Dim i As Long
|
Dim i As Long
|
||||||
For i = 1 To col.Count
|
For i = 1 To col.Count
|
||||||
arr(i) = col(i)
|
arr(i) = col(i)
|
||||||
Next i
|
Next i
|
||||||
CollectionToArray = arr
|
CollectionToArray = arr
|
||||||
End Function
|
End Function
|
||||||
@@ -1,226 +1,226 @@
|
|||||||
Sub Z1_ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long)
|
Sub Z1_ClearRowData(ByVal ws As Worksheet, ByVal rowNum As Long)
|
||||||
ws.Range(ws.Cells(rowNum, 4), ws.Cells(rowNum, 15)).ClearContents
|
ws.Range(ws.Cells(rowNum, 4), ws.Cells(rowNum, 15)).ClearContents
|
||||||
ws.Cells(rowNum, 2).ClearContents
|
ws.Cells(rowNum, 2).ClearContents
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
Sub Z1_ImportMasterDetailData()
|
Sub Z1_ImportMasterDetailData()
|
||||||
Dim filePath As String
|
Dim filePath As String
|
||||||
Dim wsTarget As Worksheet
|
Dim wsTarget As Worksheet
|
||||||
Dim lines As Variant
|
Dim lines As Variant
|
||||||
Dim i As Long
|
Dim i As Long
|
||||||
Dim dataArray As Variant
|
Dim dataArray As Variant
|
||||||
Dim code As String
|
Dim code As String
|
||||||
Dim writeRow As Long
|
Dim writeRow As Long
|
||||||
|
|
||||||
Set wsTarget = Me
|
Set wsTarget = Me
|
||||||
On Error GoTo ErrorHandler
|
On Error GoTo ErrorHandler
|
||||||
|
|
||||||
' Step 1: Select CSV file
|
' Step 1: Select CSV file
|
||||||
filePath = SelectCSVFile()
|
filePath = SelectCSVFile()
|
||||||
If filePath = "" Then Exit Sub
|
If filePath = "" Then Exit Sub
|
||||||
|
|
||||||
' Step 2: Read CSV and return 2D array
|
' Step 2: Read CSV and return 2D array
|
||||||
lines = ReadCSVAs2DArrayStrict(filePath, 7, "utf-8")
|
lines = ReadCSVAs2DArrayStrict(filePath, 7, "utf-8")
|
||||||
|
|
||||||
' Step 3: Clear data rows
|
' Step 3: Clear data rows
|
||||||
Call ClearDataRows(wsTarget, 7, 3)
|
Call ClearDataRows(wsTarget, 7, 3)
|
||||||
|
|
||||||
' Step 4: Import data
|
' Step 4: Import data
|
||||||
writeRow = 7
|
writeRow = 7
|
||||||
For i = LBound(lines, 1) To UBound(lines, 1)
|
For i = LBound(lines, 1) To UBound(lines, 1)
|
||||||
If Not isRowEmpty Then
|
If Not isRowEmpty Then
|
||||||
wsTarget.Cells(writeRow, 3).Value = CleanCSVField(CStr(lines(i, 1)))
|
wsTarget.Cells(writeRow, 3).Value = CleanCSVField(CStr(lines(i, 1)))
|
||||||
wsTarget.Cells(writeRow, 4).Value = CleanCSVField(CStr(lines(i, 2)))
|
wsTarget.Cells(writeRow, 4).Value = CleanCSVField(CStr(lines(i, 2)))
|
||||||
wsTarget.Cells(writeRow, 5).Value = CleanCSVField(CStr(lines(i, 3)))
|
wsTarget.Cells(writeRow, 5).Value = CleanCSVField(CStr(lines(i, 3)))
|
||||||
wsTarget.Cells(writeRow, 6).Value = CleanCSVField(CStr(lines(i, 4)))
|
wsTarget.Cells(writeRow, 6).Value = CleanCSVField(CStr(lines(i, 4)))
|
||||||
wsTarget.Cells(writeRow, 7).Value = CleanCSVField(CStr(lines(i, 5)))
|
wsTarget.Cells(writeRow, 7).Value = CleanCSVField(CStr(lines(i, 5)))
|
||||||
wsTarget.Cells(writeRow, 8).Value = CleanCSVField(CStr(lines(i, 6)))
|
wsTarget.Cells(writeRow, 8).Value = CleanCSVField(CStr(lines(i, 6)))
|
||||||
wsTarget.Cells(writeRow, 9).Value = CleanCSVField(CStr(lines(i, 7)))
|
wsTarget.Cells(writeRow, 9).Value = CleanCSVField(CStr(lines(i, 7)))
|
||||||
|
|
||||||
writeRow = writeRow + 1
|
writeRow = writeRow + 1
|
||||||
End If
|
End If
|
||||||
Next i
|
Next i
|
||||||
|
|
||||||
MsgBox writeRow - 7 & " rows imported.", vbInformation
|
MsgBox writeRow - 7 & " rows imported.", vbInformation
|
||||||
|
|
||||||
Exit Sub
|
Exit Sub
|
||||||
|
|
||||||
ErrorHandler:
|
ErrorHandler:
|
||||||
MsgBox "Import fails:" & vbCrLf & Err.Description, vbCritical
|
MsgBox "Import fails:" & vbCrLf & Err.Description, vbCritical
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
Sub Z1_ExportMasterDetailData()
|
Sub Z1_ExportMasterDetailData()
|
||||||
Dim ws As Worksheet
|
Dim ws As Worksheet
|
||||||
Dim lastDataRow As Long
|
Dim lastDataRow As Long
|
||||||
Dim savePath As String
|
Dim savePath As String
|
||||||
Dim r As Long
|
Dim r As Long
|
||||||
Dim rowCount As Long
|
Dim rowCount As Long
|
||||||
Dim dataArray() As Variant
|
Dim dataArray() As Variant
|
||||||
Dim dataIdx As Long
|
Dim dataIdx As Long
|
||||||
Dim j As Long
|
Dim j As Long
|
||||||
|
|
||||||
Set ws = ActiveSheet
|
Set ws = ActiveSheet
|
||||||
|
|
||||||
lastDataRow = GetLastDataRow(ws, 3)
|
lastDataRow = GetLastDataRow(ws, 3)
|
||||||
|
|
||||||
If lastDataRow < 7 Then
|
If lastDataRow < 7 Then
|
||||||
MsgBox "No data rows to output.", vbExclamation
|
MsgBox "No data rows to output.", vbExclamation
|
||||||
Exit Sub
|
Exit Sub
|
||||||
End If
|
End If
|
||||||
|
|
||||||
savePath = GetSaveCSVPath()
|
savePath = GetSaveCSVPath()
|
||||||
If savePath = "" Then Exit Sub
|
If savePath = "" Then Exit Sub
|
||||||
|
|
||||||
' Count valid rows first (C column non-empty from row 7 onward)
|
' Count valid rows first (C column non-empty from row 7 onward)
|
||||||
rowCount = 0
|
rowCount = 0
|
||||||
For r = 7 To lastDataRow
|
For r = 7 To lastDataRow
|
||||||
If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then
|
If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then
|
||||||
rowCount = rowCount + 1
|
rowCount = rowCount + 1
|
||||||
End If
|
End If
|
||||||
Next r
|
Next r
|
||||||
|
|
||||||
' If no data, exit
|
' If no data, exit
|
||||||
If rowCount = 0 Then
|
If rowCount = 0 Then
|
||||||
MsgBox "No data rows to output.", vbExclamation
|
MsgBox "No data rows to output.", vbExclamation
|
||||||
Exit Sub
|
Exit Sub
|
||||||
End If
|
End If
|
||||||
|
|
||||||
' Initialize 2D array: (1 To rowCount, 1 To 7) for columns C-I (3 to 9)
|
' Initialize 2D array: (1 To rowCount, 1 To 7) for columns C-I (3 to 9)
|
||||||
ReDim dataArray(1 To rowCount, 1 To 7)
|
ReDim dataArray(1 To rowCount, 1 To 7)
|
||||||
|
|
||||||
' Fill the array
|
' Fill the array
|
||||||
dataIdx = 0
|
dataIdx = 0
|
||||||
For r = 7 To lastDataRow
|
For r = 7 To lastDataRow
|
||||||
If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then
|
If Len(Trim(ws.Cells(r, 3).Value & "")) > 0 Then
|
||||||
dataIdx = dataIdx + 1
|
dataIdx = dataIdx + 1
|
||||||
For j = 3 To 9
|
For j = 3 To 9
|
||||||
dataArray(dataIdx, j - 2) = ws.Cells(r, j).Value ' C->1, D->2, ..., I->7
|
dataArray(dataIdx, j - 2) = ws.Cells(r, j).Value ' C->1, D->2, ..., I->7
|
||||||
Next j
|
Next j
|
||||||
End If
|
End If
|
||||||
Next r
|
Next r
|
||||||
|
|
||||||
' Write using the new array-based CSV writer
|
' Write using the new array-based CSV writer
|
||||||
Call WriteCSVFromArray(savePath, dataArray, "utf-8", True)
|
Call WriteCSVFromArray(savePath, dataArray, "utf-8", True)
|
||||||
|
|
||||||
MsgBox "CSV export completed. Total data rows: " & rowCount, vbInformation
|
MsgBox "CSV export completed. Total data rows: " & rowCount, vbInformation
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
Sub Z1_validateDetailData(ByVal ws As Worksheet, ByVal rowNum As Long)
|
Sub Z1_validate(ByVal ws As Worksheet, ByVal rowNum As Long)
|
||||||
Dim cValue As String
|
Dim cValue As String
|
||||||
cValue = Trim(ws.Cells(rowNum, 3).Value)
|
cValue = Trim(ws.Cells(rowNum, 3).Value)
|
||||||
|
|
||||||
If cValue = "" Then
|
If cValue = "" Then
|
||||||
ws.Cells(rowNum, 2).Value = "C column is required"
|
ws.Cells(rowNum, 2).Value = "C column is required"
|
||||||
Exit Sub
|
Exit Sub
|
||||||
End If
|
End If
|
||||||
|
|
||||||
If Len(cValue) <> 3 Then
|
If Len(cValue) <> 3 Then
|
||||||
ws.Cells(rowNum, 2).Value = "C column must be 3 characters"
|
ws.Cells(rowNum, 2).Value = "C column must be 3 characters"
|
||||||
Exit Sub
|
Exit Sub
|
||||||
End If
|
End If
|
||||||
|
|
||||||
Dim i As Long
|
Dim i As Long
|
||||||
Dim ch As String
|
Dim ch As String
|
||||||
For i = 1 To 3
|
For i = 1 To 3
|
||||||
ch = Mid(cValue, i, 1)
|
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
|
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, 2).Value = "C column must be alphanumeric"
|
||||||
Exit Sub
|
Exit Sub
|
||||||
End If
|
End If
|
||||||
Next i
|
Next i
|
||||||
|
|
||||||
Dim dValue As String
|
Dim dValue As String
|
||||||
dValue = Trim(ws.Cells(rowNum, 4).Value)
|
dValue = Trim(ws.Cells(rowNum, 4).Value)
|
||||||
If dValue = "" Then
|
If dValue = "" Then
|
||||||
ws.Cells(rowNum, 2).Value = "D column is required"
|
ws.Cells(rowNum, 2).Value = "D column is required"
|
||||||
Exit Sub
|
Exit Sub
|
||||||
End If
|
End If
|
||||||
If Len(dValue) > 80 Then
|
If Len(dValue) > 80 Then
|
||||||
ws.Cells(rowNum, 2).Value = "D column must be within 80 characters"
|
ws.Cells(rowNum, 2).Value = "D column must be within 80 characters"
|
||||||
Exit Sub
|
Exit Sub
|
||||||
End If
|
End If
|
||||||
|
|
||||||
Dim eValue As String
|
Dim eValue As String
|
||||||
eValue = Trim(ws.Cells(rowNum, 5).Value)
|
eValue = Trim(ws.Cells(rowNum, 5).Value)
|
||||||
If eValue = "" Then
|
If eValue = "" Then
|
||||||
ws.Cells(rowNum, 2).Value = "E column is required"
|
ws.Cells(rowNum, 2).Value = "E column is required"
|
||||||
Exit Sub
|
Exit Sub
|
||||||
End If
|
End If
|
||||||
If Len(eValue) > 80 Then
|
If Len(eValue) > 80 Then
|
||||||
ws.Cells(rowNum, 2).Value = "E column must be within 80 characters"
|
ws.Cells(rowNum, 2).Value = "E column must be within 80 characters"
|
||||||
Exit Sub
|
Exit Sub
|
||||||
End If
|
End If
|
||||||
|
|
||||||
Dim fValue As String
|
Dim fValue As String
|
||||||
fValue = Trim(ws.Cells(rowNum, 6).Value)
|
fValue = Trim(ws.Cells(rowNum, 6).Value)
|
||||||
If fValue <> "" And Len(fValue) > 80 Then
|
If fValue <> "" And Len(fValue) > 80 Then
|
||||||
ws.Cells(rowNum, 2).Value = "F column must be within 80 characters"
|
ws.Cells(rowNum, 2).Value = "F column must be within 80 characters"
|
||||||
Exit Sub
|
Exit Sub
|
||||||
End If
|
End If
|
||||||
|
|
||||||
Dim gValue As String
|
Dim gValue As String
|
||||||
gValue = Trim(ws.Cells(rowNum, 7).Value)
|
gValue = Trim(ws.Cells(rowNum, 7).Value)
|
||||||
If gValue <> "" And Len(gValue) > 80 Then
|
If gValue <> "" And Len(gValue) > 80 Then
|
||||||
ws.Cells(rowNum, 2).Value = "G column must be within 80 characters"
|
ws.Cells(rowNum, 2).Value = "G column must be within 80 characters"
|
||||||
Exit Sub
|
Exit Sub
|
||||||
End If
|
End If
|
||||||
|
|
||||||
Dim iValue As String
|
Dim iValue As String
|
||||||
iValue = Trim(ws.Cells(rowNum, 9).Value)
|
iValue = Trim(ws.Cells(rowNum, 9).Value)
|
||||||
If iValue <> "" And Len(iValue) > 80 Then
|
If iValue <> "" And Len(iValue) > 80 Then
|
||||||
ws.Cells(rowNum, 2).Value = "I column must be within 80 characters"
|
ws.Cells(rowNum, 2).Value = "I column must be within 80 characters"
|
||||||
Exit Sub
|
Exit Sub
|
||||||
End If
|
End If
|
||||||
|
|
||||||
Dim hValue As String
|
Dim hValue As String
|
||||||
hValue = Trim(ws.Cells(rowNum, 8).Value)
|
hValue = Trim(ws.Cells(rowNum, 8).Value)
|
||||||
If hValue <> "" Then
|
If hValue <> "" Then
|
||||||
If Len(hValue) <> 1 Then
|
If Len(hValue) <> 1 Then
|
||||||
ws.Cells(rowNum, 2).Value = "H column must be 1 digit"
|
ws.Cells(rowNum, 2).Value = "H column must be 1 digit"
|
||||||
Exit Sub
|
Exit Sub
|
||||||
End If
|
End If
|
||||||
If hValue <> "0" And hValue <> "1" Then
|
If hValue <> "0" And hValue <> "1" Then
|
||||||
ws.Cells(rowNum, 2).Value = "H column must be 0 or 1"
|
ws.Cells(rowNum, 2).Value = "H column must be 0 or 1"
|
||||||
Exit Sub
|
Exit Sub
|
||||||
End If
|
End If
|
||||||
End If
|
End If
|
||||||
|
|
||||||
ws.Cells(rowNum, 2).ClearContents
|
ws.Cells(rowNum, 2).ClearContents
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
Sub Z1_validateDetailDataButton()
|
Sub Z1_validateButton()
|
||||||
Dim ws As Worksheet
|
Dim ws As Worksheet
|
||||||
Dim lastRow As Long
|
Dim lastRow As Long
|
||||||
Dim r As Long
|
Dim r As Long
|
||||||
Dim errorCount As Long
|
Dim errorCount As Long
|
||||||
|
|
||||||
Set ws = ActiveSheet
|
Set ws = ActiveSheet
|
||||||
lastRow = GetLastDataRow(ws, 3)
|
lastRow = GetLastDataRow(ws, 3)
|
||||||
|
|
||||||
If lastRow < 7 Then
|
If lastRow < 7 Then
|
||||||
MsgBox "No data found.", vbExclamation
|
MsgBox "No data found.", vbExclamation
|
||||||
Exit Sub
|
Exit Sub
|
||||||
End If
|
End If
|
||||||
|
|
||||||
errorCount = 0
|
errorCount = 0
|
||||||
For r = 7 To lastRow
|
For r = 7 To lastRow
|
||||||
Call Z1_validateDetailData(ws, r)
|
Call Z1_validate(ws, r)
|
||||||
If Trim(ws.Cells(r, 2).Value) <> "" Then
|
If Trim(ws.Cells(r, 2).Value) <> "" Then
|
||||||
errorCount = errorCount + 1
|
errorCount = errorCount + 1
|
||||||
End If
|
End If
|
||||||
Next r
|
Next r
|
||||||
|
|
||||||
MsgBox "Validation complete. Errors: " & errorCount, vbInformation
|
MsgBox "Validation complete. Errors: " & errorCount, vbInformation
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
Sub Z1_SortDataRowsByC()
|
Sub Z1_SortDataRowsByC()
|
||||||
Call SortDataRows(3)
|
Call SortDataRows(3)
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
Sub Z1_ToggleAutoFilter()
|
Sub Z1_ToggleAutoFilter()
|
||||||
Call ToggleAutoFilter(6)
|
Call ToggleAutoFilter(6)
|
||||||
End Sub
|
End Sub
|
||||||
|
|
||||||
Sub Z1_AutoFitColumnWidth()
|
Sub Z1_AutoFitColumnWidth()
|
||||||
Call AutoFitColumnWidth()
|
Call AutoFitColumnWidth()
|
||||||
End Sub
|
End Sub
|
||||||
BIN
~$通勤手当テンプレート_案.xlsm
Normal file
BIN
~$通勤手当テンプレート_案.xlsm
Normal file
Binary file not shown.
Binary file not shown.
Reference in New Issue
Block a user