Files
vba/vba_code_common.bas
2026-04-14 15:52:33 +09:00

93 lines
2.6 KiB
QBasic

' ============================================================
' 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
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