WorkSheetCommon

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