' ============================================================ ' Common Functions ' ============================================================ Function CleanCSVField(ByVal inputStr As String) As String Dim s As String s = Trim(inputStr) ' calcute If Len(s) > 0 Then Select Case Left(s, 1) Case "=", "+", "-", "@" CleanCSVField = "'" & s Exit Function End Select End If CleanCSVField = s End Function Function GetLastDataRow(ByVal ws As Worksheet, ByVal columnNum As Long) As Long GetLastDataRow = ws.Cells(ws.Rows.Count, columnNum).End(xlUp).Row End Function Sub ClearDataRows(ByVal ws As Worksheet, ByVal startRow As Long, ByVal columnNum As Long) Dim lastRow As Long lastRow = ws.Cells(ws.Rows.Count, columnNum).End(xlUp).Row If lastRow >= startRow Then ws.Range(ws.Cells(startRow, 1), ws.Cells(lastRow, 20)).ClearContents End If End Sub Function SelectCSVFile() As String Dim fileDialog As FileDialog Set fileDialog = Application.FileDialog(msoFileDialogFilePicker) With fileDialog .Filters.Clear .Filters.Add "CSV Files", "*.csv" .AllowMultiSelect = False If .Show <> -1 Then SelectCSVFile = "" Exit Function End If SelectCSVFile = .SelectedItems(1) End With End Function Function GetSaveCSVPath(Optional ByVal defaultName As String = "") As String Dim savePath As String savePath = Application.GetSaveAsFilename( _ FileFilter:="CSV Files (*.csv), *.csv", _ Title:="Save CSV", _ InitialFileName:=defaultName) If savePath = "False" Or savePath = "" Then GetSaveCSVPath = "" Exit Function End If If InStr(1, savePath, ".csv", vbTextCompare) = 0 Then savePath = savePath & ".csv" End If GetSaveCSVPath = savePath End Function Sub WriteCSVFile(ByVal filePath As String, ByVal content As String) Dim stream As Object Set stream = CreateObject("ADODB.Stream") With stream .Type = 2 .Charset = "shift_jis" .Open .WriteText content, 0 .SaveToFile filePath, 2 .Close End With End Sub ' 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. ' If the file is empty and defaultColumnCount > 0, returns an empty 2D array with zero rows and defaultColumnCount columns. ' Parameters: ' filePath: Full path to the CSV file. ' charset: Text encoding (e.g., "cp932", "utf-8"). ' defaultColumnCount: Optional. Used only if CSV has no rows. Must be >= 0. Function ReadCSVAs2DArrayStrict( _ ByVal filePath As String, _ ByVal expectedColumnCount As Long, _ Optional ByVal charset As String = "cp932", _ Optional ByVal hasHeader As Boolean = False) As Variant ' === validate expectedColumnCount === If expectedColumnCount <= 0 Then Err.Raise 5001, , "expectedColumnCount must be >= 1." End If If Dir(filePath) = "" Then Err.Raise 5002, , "File not found: " & filePath End If ' === read csv file === Dim stream As Object Set stream = CreateObject("ADODB.Stream") With stream .Type = 2 ' adTypeText .charset = charset .Open .LoadFromFile filePath Dim textContent As String textContent = .ReadText .Close End With ' === stardand === textContent = Replace(textContent, vbCrLf, vbLf) textContent = Replace(textContent, vbCr, vbLf) ' === transfer into collection === Dim lines As Collection Set lines = ParseCSVLines(textContent) ' === validate empty === If lines.Count = 0 Then Err.Raise 5003, , "CSV file is empty." End If ' === loop the row, validate column count === Dim i As Long For i = 1 To lines.Count Dim rowArr As Variant rowArr = lines(i) Dim actualCols As Long actualCols = UBound(rowArr) - LBound(rowArr) + 1 If actualCols <> expectedColumnCount Then Err.Raise 5004, , "Row " & i & ": Expected " & expectedColumnCount & " columns, got " & actualCols & "." End If Next i Dim result As Variant ReDim result(1 To lines.Count, 1 To expectedColumnCount) For i = 1 To lines.Count rowArr = lines(i) Dim j As Long For j = LBound(rowArr) To UBound(rowArr) result(i, j - LBound(rowArr) + 1) = rowArr(j) Next j Next i ReadCSVAs2DArrayStrict = result End Function ' Helper function: Parse CSV text into collection of string arrays (zero-based per row) Private Function ParseCSVLines(ByVal csvText As String) As Collection Set ParseCSVLines = New Collection Dim length As Long: length = Len(csvText) If length = 0 Then Exit Function Dim i As Long: i = 1 Dim currentField As String Dim currentRow As Collection: Set currentRow = New Collection Dim inQuotes As Boolean Dim c As String Do While i <= length c = Mid$(csvText, i, 1) Select Case c Case """" If inQuotes Then If i < length And Mid$(csvText, i + 1, 1) = """" Then currentField = currentField & """" i = i + 2 Else inQuotes = False i = i + 1 End If Else inQuotes = True i = i + 1 End If Case "," If inQuotes Then currentField = currentField & c i = i + 1 Else currentRow.Add currentField currentField = "" i = i + 1 End If Case vbLf If inQuotes Then currentField = currentField & c i = i + 1 Else currentRow.Add currentField Dim arr() As String If currentRow.Count > 0 Then ReDim arr(0 To currentRow.Count - 1) Dim k As Long For k = 1 To currentRow.Count arr(k - 1) = currentRow(k) Next k End If ParseCSVLines.Add arr Set currentRow = New Collection currentField = "" inQuotes = False i = i + 1 End If Case Else currentField = currentField & c i = i + 1 End Select Loop ' Handle last row without trailing newline If currentField <> "" Or currentRow.Count > 0 Then currentRow.Add currentField Dim lastArr() As String If currentRow.Count > 0 Then ReDim lastArr(0 To currentRow.Count - 1) Dim m As Long For m = 1 To currentRow.Count lastArr(m - 1) = currentRow(m) Next m End If ParseCSVLines.Add lastArr End If End Function Sub SortDataRows(Optional ByVal sortColumn As Long = 3) Dim ws As Worksheet Dim lastRow As Long Dim startRow As Long Dim sortOrder As Long Set ws = ActiveSheet startRow = 7 lastRow = GetLastDataRow(ws, sortColumn) If lastRow < startRow Then MsgBox "No data to sort.", vbExclamation Exit Sub End If ' Determine sort order based on first row's current state Dim currentFirst As String Dim nextFirst As String currentFirst = Trim(ws.Cells(startRow, sortColumn).Value) nextFirst = Trim(ws.Cells(startRow + 1, sortColumn).Value) If currentFirst <> "" And nextFirst <> "" Then If currentFirst > nextFirst Then sortOrder = xlAscending Else sortOrder = xlDescending End If Else sortOrder = xlAscending End If ws.Range(ws.Cells(startRow, 1), ws.Cells(lastRow, 20)).Sort _ Key1:=ws.Cells(startRow, sortColumn), _ Order1:=sortOrder, _ Header:=xlNo End Sub Sub ToggleAutoFilter(Optional ByVal filterRow As Long = 6) Dim ws As Worksheet Set ws = ActiveSheet ' Check if auto filter is already on If ws.AutoFilterMode Then ws.AutoFilterMode = False Else If filterRow >= 1 Then ws.Rows(filterRow).AutoFilter End If End If End Sub Sub AutoFitColumnWidth(Optional ByVal fitColumnStart As Long = 2, Optional ByVal fitColumnEnd As Long = 9) Dim ws As Worksheet Set ws = ActiveSheet If fitColumnStart <= fitColumnEnd Then ws.Range(ws.Columns(fitColumnStart), ws.Columns(fitColumnEnd)).AutoFit End If End Sub