' ============================================================ ' Common Functions ' ============================================================ Function CleanCSVField(ByVal field As Variant) As String If IsEmpty(field) Or IsNull(field) Then CleanCSVField = "" Exit Function End If Dim result As String result = Trim(CStr(field)) If Len(result) >= 2 Then If Left(result, 1) = """" And Right(result, 1) = """" Then result = Mid(result, 2, Len(result) - 2) result = Replace(result, """""", """") End If End If CleanCSVField = result End Function Function ValidateCSVColumnCount(ByVal lines As Variant, ByVal expectedColumns As Long) As Boolean ValidateCSVColumnCount = True Dim lineNum As Long Dim dataArray As Variant Dim validRowCount As Long validRowCount = 0 For lineNum = 0 To UBound(lines) If Trim(lines(lineNum)) <> "" Then dataArray = Split(lines(lineNum), ",") If UBound(dataArray) + 1 <> expectedColumns Then MsgBox "CSV line " & (lineNum + 1) & " has " & (UBound(dataArray) + 1) & " columns. Expected " & expectedColumns & ".", vbExclamation ValidateCSVColumnCount = False Exit Function End If validRowCount = validRowCount + 1 End If Next lineNum If validRowCount = 0 Then MsgBox "No valid data in CSV.", vbExclamation ValidateCSVColumnCount = False End If 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 Function ReadCSVFile(ByVal filePath As String, Optional ByVal charset As String = "shift_jis") As Variant If filePath = "" Then ReadCSVFile = Array() Exit Function End If Dim stream As Object Dim textContent As String Set stream = CreateObject("ADODB.Stream") With stream .Type = 2 .Charset = charset .Open .LoadFromFile filePath textContent = .ReadText .Close End With ReadCSVFile = Split(textContent, vbLf) 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