Option Explicit
'このモジュールはワークシートモジュールでよく使う関数をまとめたものです。
'ロガー用 シート名
Public Function Source(ByRef ws As Worksheet) As String
Source = ws.name & "シート"
End Function
'列末
Public Function C_DATA_TAIL(ByRef ws As Worksheet, ByVal ref_r As Long) As Long
C_DATA_TAIL = smCommon.SearchColTail(ws, ref_r)
End Function
'行末
Public Function R_DATA_TAIL(ByRef ws As Worksheet, ByVal ref_c As Long) As Long
R_DATA_TAIL = smCommon.SearchRowTail(ws, ref_c)
End Function
'列追加位置
Public Function C_NEXT(ByVal start_c As Long, ByVal tail_c As Long) As Long
C_NEXT = IIf(start_c - 1 < tail_c, tail_c + 1, start_c)
End Function
'行追加位置
Public Function R_NEXT(ByVal start_r As Long, ByVal tail_r As Long) As Long
R_NEXT = IIf(start_r - 1 < tail_r, tail_r + 1, start_r)
End Function
'データがあるか
Public Function DataExist(ByVal start_r As Long, ByVal start_c As Long, _
ByVal tail_r As Long, ByVal tail_c As Long) As Boolean
DataExist = ((start_r <= tail_r) And (start_c <= tail_c))
End Function
'データ範囲
Public Function DataRange(ByRef ws As Worksheet, _
ByVal start_r As Long, ByVal start_c As Long, _
ByVal tail_r As Long, ByVal tail_c As Long, _
ByVal start_rh As Long, ByVal start_ch As Long, _
Optional ByVal isheader_r As Boolean = False, _
Optional ByVal isheader_c As Boolean = False) As Range
If ws Is Nothing Then Exit Function
If DataExist(start_r, start_c, tail_r, tail_c) = False Then Exit Function
Set DataRange = ws.Range(ws.Cells(IIf(isheader_c, start_rh, start_r), _
IIf(isheader_r, start_ch, start_c)), _
ws.Cells(tail_r, tail_c))
End Function
'列ヘッダ範囲
Public Function ColHeaderRange(ByRef ws As Worksheet, ByVal start_rh As Long, ByVal start_ch As Long, _
ByVal tail_rh As Long, ByVal tail_c As Long) As Range
If tail_c < start_ch Then Exit Function
Set ColHeaderRange = ws.Range(ws.Cells(start_rh, start_ch), ws.Cells(tail_rh, tail_c))
End Function
'行ヘッダ範囲
Public Function RowHeaderRange(ByRef ws As Worksheet, ByVal start_r As Long, ByVal start_ch As Long, _
ByVal tail_r As Long, ByVal tail_ch As Long) As Range
If tail_r < start_r Then Exit Function
Set RowHeaderRange = ws.Range(ws.Cells(start_r, start_ch), ws.Cells(tail_r, tail_ch))
End Function
'オートフィルターの範囲
Public Function FillterRange(ByRef ws As Worksheet, ByVal tail_rh As Long, _
ByVal start_ch As Long, ByVal tail_c As Long) As Range
If tail_c < start_ch Then Exit Function
Set FillterRange = ws.Range(ws.Cells(tail_rh, start_ch), ws.Cells(tail_rh, tail_c))
End Function
'フィルターリセット
Public Function FillterReset(ByRef ws As Worksheet, ByRef frng As Range)
ws.AutoFilterMode = False
If frng Is Nothing = False Then Call frng.AutoFilter
End Function
'表示整理
Public Function Organize(ByRef ws As Worksheet, ByRef frng As Range, _
ByVal start_r As Long, ByVal start_c As Long, _
ByVal tail_r As Long, ByVal tail_c As Long, _
ByVal start_rh As Long, ByVal start_ch As Long, _
ByVal tail_rh As Long, ByVal tail_ch As Long, _
Optional ByVal activate As Boolean = False)
Call FillterReset(ws, frng)
If activate Then
Call ws.activate
ws.Cells(1, 1).Select
ActiveWindow.ScrollRow = 1
ActiveWindow.ScrollColumn = 1
If tail_rh > 1 Then ActiveWindow.SplitRow = tail_rh
If tail_ch > 1 Then ActiveWindow.SplitColumn = tail_ch
ActiveWindow.Split = True
ActiveWindow.FreezePanes = True
ActiveWindow.DisplayGridlines = False
End If
If start_rh < start_r Then
ColHeaderRange(ws, start_rh, start_ch, tail_rh, tail_c).Interior.ColorIndex = eColorIndex.LightCyan
ColHeaderRange(ws, start_rh, start_ch, tail_rh, tail_c).Font.Bold = True
End If
If DataExist(start_r, start_c, tail_r, tail_c) Then
DataRange(ws, start_r, start_c, tail_r, tail_c, start_rh, start_ch, True, True).Borders.LineStyle = xlNone
DataRange(ws, start_r, start_c, tail_r, tail_c, start_rh, start_ch, True, True).Borders.LineStyle = xlContinuous
DataRange(ws, start_r, start_c, tail_r, tail_c, start_rh, start_ch, True, False).Borders(xlInsideHorizontal).Weight = xlHairline
Call DataRange(ws, start_r, start_c, tail_r, tail_c, start_rh, start_ch, True, True).columns.AutoFit
End If
End Function
'列ヘッダをリストにする(2列の場合は結合する)
Public Function ColumnList(ByRef cheader As Range) As Collection
Set ColumnList = New Collection
Dim col As Long, h1 As String, h2 As String
For col = 1 To cheader.columns.Count
Select Case cheader.rows.Count
Case 1
h1 = smCommon.FirstValue(cheader.Cells(1, col))
Call ColumnList.add(h1)
Case 2
h1 = smCommon.FirstValue(cheader.Cells(1, col))
h2 = smCommon.FirstValue(cheader.Cells(2, col))
If Len(h1) = 0 Or Len(h2) = 0 Then
Call ColumnList.add(h1 & h2)
Else
Call ColumnList.add(h1 & "@" & h2)
End If
Case 3
Call ColumnList.add(JoinEx(Array(smCommon.FirstValue(cheader.Cells(1, col)), _
smCommon.FirstValue(cheader.Cells(2, col)), _
smCommon.FirstValue(cheader.Cells(3, col))), "@"))
Case Else
Err.Raise ERROR_CODE, "未実装", "この処理は未実装です"
End Select
Next col
End Function