Notes

VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "clsWorkSheet"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

'**********************************************************************************************

'対象シート
Private m_wsSheet As Worksheet

'配列を行方向に追加できるように行列入れ替えた2次元配列
Private m_varAry As Variant

'データ部開始終了番号
Private m_lRow_DataST As Long
Private m_lCol_DataST As Long
Private m_lRow_DataED As Long
Private m_lCol_DataED As Long

'データ個数
Private m_lRow_DataCount As Long
Private m_lCol_DataCount As Long

'最終ライン番号
Private m_lRow_Last As Long
Private m_lCol_Last As Long

'見出しライン数
Private m_lRowHeader_Count As Long
Private m_lColHeader_Count As Long

'空ラインの数
Private m_lRowEmpty_Count As Long
Private m_lColEmpty_Count As Long

'基準列(連続していることが前提の表の大きさを測る)
Private m_lRow_BaseLine As Long
Private m_lCol_BaseLine As Long

'表の開始番号
Private m_lRow_Table_ST As Long
Private m_lCol_Table_ST As Long

'最終番号の取得方法
Private m_lLastRow_Method As Long
Private m_lLastCol_Method As Long

'**********************************************************************************************

Private Sub Class_Initialize()

Set m_wsSheet = Nothing
m_varAry = Empty
m_lRow_DataST = -1
m_lCol_DataST = -1
m_lRow_DataED = -1
m_lCol_DataED = -1
m_lRow_DataCount = -1
m_lCol_DataCount = -1
m_lRow_Last = -1
m_lCol_Last = -1
m_lRowHeader_Count = -1
m_lColHeader_Count = -1
m_lRowEmpty_Count = -1
m_lColEmpty_Count = -1
m_lRow_BaseLine = -1
m_lCol_BaseLine = -1
m_lRow_Table_ST = -1
m_lCol_Table_ST = -1
m_lLastRow_Method = -1
m_lLastCol_Method = -1

End Sub

Private Sub Class_Terminate()

Set m_varAry = Nothing
Set m_wsSheet = Nothing

End Sub

'**********************************************************************************************

Public Property Get varAry(Optional ByVal lRow As Long = 0, Optional ByVal lCol As Long = 0) As Variant
If lRow > 0 And lCol > 0 Then
varAry = m_varAry(lCol, lRow)
Else
varAry = MyTranspose(m_varAry)
End If
End Property

Public Property Let varAry(ByVal lRow As Long, ByVal lCol As Long, ByVal varValue As Variant)
m_varAry(lCol, lRow) = varValue
End Property

Public Property Let varAry_set(ByRef varAry As Variant)
m_varAry = MyTranspose(varAry)
End Property

Public Property Get varAry_RowCount()
varAry_RowCount = Get_ArrayCount(m_varAry, 2)
End Property

Public Property Get varAry_ColCount()
varAry_ColCount = Get_ArrayCount(m_varAry, 1)
End Property

Public Property Get Row_DataStart() As Long
Row_DataStart = m_lRow_DataST
End Property

Public Property Get Col_DataStart() As Long
Col_DataStart = m_lCol_DataST
End Property

Public Property Get Row_DataCount() As Long
Row_DataCount = m_lRow_DataCount
End Property

Public Property Get Col_DataCount() As Long
Col_DataCount = m_lCol_DataCount
End Property

Public Property Get Row_Last() As Long
Row_Last = m_lRow_Last
End Property

Public Property Get Col_Last() As Long
Col_Last = m_lCol_Last
End Property

Public Property Get Name() As String
Name = m_wsSheet.Name
End Property

Public Property Let Name(ByVal str As String)
m_wsSheet.Name = str
End Property

Public Property Get Sheet() As Worksheet
Set Sheet = m_wsSheet
End Property

Public Property Get Row_Table_ST() As Long
Row_Table_ST = m_lRow_Table_ST
End Property

Public Property Get Col_Table_ST() As Long
Col_Table_ST = m_lCol_Table_ST
End Property

Public Property Get Row_HeaderCount() As Long
Row_HeaderCount = m_lRowHeader_Count + m_lRowEmpty_Count
End Property

Public Property Get Col_HeaderCount() As Long
Col_HeaderCount = m_lColHeader_Count + m_lColEmpty_Count
End Property

'**********************************************************************************************

'初期化処理

Public Sub Init_Proc(Optional ByRef ws As Worksheet = Nothing, _
Optional ByVal lRowHeaderCnt As Long = -1, Optional ByVal lColHeaderCnt As Long = 0, _
Optional ByVal lBaseRowLine As Long = 1, Optional ByVal lBaseColLine As Long = 1, _
Optional ByVal lRowEmpty_Cnt As Long = 0, Optional ByVal lColEmpty_Cnt As Long = 0, _
Optional ByVal lLastRow_Method As Long = 1, Optional ByVal lLastCol_Method As Long = 1)

If Not ws Is Nothing Then Set m_wsSheet = ws

m_lLastRow_Method = lLastRow_Method
m_lLastCol_Method = lLastCol_Method

If lRowHeaderCnt < 0 Then Exit Sub
'フィルタ解除
Call Me.Release_Filter

m_lRowHeader_Count = lRowHeaderCnt
m_lColHeader_Count = lColHeaderCnt
m_lRowEmpty_Count = lRowEmpty_Cnt
m_lColEmpty_Count = lColEmpty_Cnt
m_lRow_BaseLine = lBaseRowLine
m_lCol_BaseLine = lBaseColLine

m_lRow_DataST = 1 + lRowHeaderCnt + lRowEmpty_Cnt
m_lCol_DataST = 1 + lColHeaderCnt + lColEmpty_Cnt

m_lRow_Table_ST = 1 + m_lRowEmpty_Count
m_lCol_Table_ST = 1 + m_lColEmpty_Count

Select Case m_lLastRow_Method
Case 1
m_lRow_DataED = m_wsSheet.Cells(m_wsSheet.Rows.Count, m_lCol_BaseLine).End(xlUp).Row
Case 2
m_lRow_DataED = Get_LastRow_supperts_MergeCell
End Select

Select Case m_lLastCol_Method
Case 1
m_lCol_DataED = m_wsSheet.Cells(m_lRow_BaseLine, m_wsSheet.Columns.Count).End(xlToLeft).Column
Case 2
m_lCol_DataED = Get_LastCol_supperts_MergeCell
End Select

m_lRow_Last = m_lRow_DataED
m_lCol_Last = m_lCol_DataED
m_lRow_DataCount = m_lRow_DataED - m_lRow_DataST + 1
m_lCol_DataCount = m_lCol_DataED - m_lCol_DataST + 1
'全データを格納
m_varAry = m_wsSheet.Range(m_wsSheet.Cells(1, 1), m_wsSheet.Cells(m_lRow_Last, m_lCol_Last))
'配列を行方向に追加できるように行列入れ替え
m_varAry = MyTranspose(m_varAry)

End Sub

'**********************************************************************************************

'データ更新処理

Public Sub Refresh_Proc(Optional ByVal lRowHeaderCnt As Long = -1, Optional ByVal lColHeaderCnt As Long = -1, _
Optional ByVal lBaseRowLine As Long = -1, Optional ByVal lBaseColLine As Long = -1, _
Optional ByVal lRowEmpty_Cnt As Long = -1, Optional ByVal lColEmpty_Cnt As Long = -1, _
Optional ByRef varAryHeader As Variant = Empty)

Dim i As Long

If lRowHeaderCnt <> -1 Then m_lRowHeader_Count = lRowHeaderCnt
If lColHeaderCnt <> -1 Then m_lColHeader_Count = lColHeaderCnt
If lRowEmpty_Cnt <> -1 Then m_lRowEmpty_Count = lRowEmpty_Cnt
If lColEmpty_Cnt <> -1 Then m_lColEmpty_Count = lColEmpty_Cnt
If lBaseRowLine <> -1 Then m_lRow_BaseLine = lBaseRowLine
If lBaseColLine <> -1 Then m_lCol_BaseLine = lBaseColLine

m_lRow_DataST = 1 + m_lRowHeader_Count + m_lRowEmpty_Count
m_lCol_DataST = 1 + m_lColHeader_Count + m_lColEmpty_Count

m_lRow_Table_ST = 1 + m_lRowEmpty_Count
m_lCol_Table_ST = 1 + m_lColEmpty_Count

Select Case TypeName(varAryHeader)
Case "Empty"

Select Case m_lLastRow_Method
Case 1
m_lRow_DataED = m_wsSheet.Cells(m_wsSheet.Rows.Count, m_lCol_BaseLine).End(xlUp).Row
Case 2
m_lRow_DataED = Get_LastRow_supperts_MergeCell
End Select

Select Case m_lLastCol_Method
Case 1
m_lCol_DataED = m_wsSheet.Cells(m_lRow_BaseLine, m_wsSheet.Columns.Count).End(xlToLeft).Column
Case 2
m_lCol_DataED = Get_LastCol_supperts_MergeCell
End Select

'全データを格納
m_varAry = m_wsSheet.Range(m_wsSheet.Cells(1, 1), m_wsSheet.Cells(m_lRow_DataED, m_lCol_DataED))
'配列を行方向に追加できるように行列入れ替え
m_varAry = MyTranspose(m_varAry)

Case "Variant()"

m_lRow_DataED = 1
m_lCol_DataED = Get_ArrayCount(varAryHeader)
ReDim m_varAry(1 To m_lCol_DataED, 1 To 1)
For i = 1 To m_lCol_DataED Step 1
m_varAry(i, 1) = varAryHeader(i - 1)
Next i

End Select

m_lRow_Last = m_lRow_DataED
m_lCol_Last = m_lCol_DataED
m_lRow_DataCount = m_lRow_DataED - m_lRow_DataST + 1
m_lCol_DataCount = m_lCol_DataED - m_lCol_DataST + 1

End Sub

'**********************************************************************************************

'表の先頭ラインを検索し指定個数隣りの値を取得(Variant配列から)

Public Function Get_CellValue(ByVal strSearch_Target As String, ByVal lReturn_POS As Long, _
Optional ByVal bSearch_Direction_Row As Boolean = True) As Variant

On Error GoTo END_PROC
'行を検索
If bSearch_Direction_Row = True Then
Get_CellValue = WorksheetFunction.HLookup(strSearch_Target, m_varAry, lReturn_POS, False)
'列を検索
Else
Get_CellValue = WorksheetFunction.VLookup(strSearch_Target, m_varAry, lReturn_POS, False)
End If
END_PROC:

End Function

'**********************************************************************************************

'検索文字列を開始から終了の間から見つける(シート内から) Index+Match版

Public Function Get_CellValue2(ByVal strTarget As String, ByVal lReturnLineNo As Long, _
ByVal lSearchLineNo As Long, _
Optional ByVal bSearch_Direction_Row As Boolean = True) As String
Dim rng As Range
Dim lResult As Long

Get_CellValue2 = ""
With m_wsSheet
If bSearch_Direction_Row = True Then
Set rng = .Range(.Cells(1, lSearchLineNo), .Cells(m_lRow_Last, lSearchLineNo))
Else
Set rng = .Range(.Cells(lSearchLineNo, 1), .Cells(lSearchLineNo, m_lCol_Last))
End If
On Error Resume Next
lResult = WorksheetFunction.Match(strTarget, rng, 0)
On Error GoTo 0 '発生しているエラーをクリア
If bSearch_Direction_Row = True Then
Set rng = .Range(.Cells(1, lReturnLineNo), .Cells(m_lRow_Last, lReturnLineNo))
Get_CellValue2 = CStr(WorksheetFunction.index(rng, lResult, 1))
Else
Set rng = .Range(.Cells(lReturnLineNo, 1), .Cells(lReturnLineNo, m_lCol_Last))
Get_CellValue2 = CStr(WorksheetFunction.index(rng, 1, lResult))
End If
End With
Set rng = Nothing

End Function

'**********************************************************************************************

'Variant配列から値取得

Public Function Get_CellValue3(ByVal strSearch_Target As String, ByVal lSearch_POS As Long, _
ByVal lReturn_POS As Long, _
Optional ByVal bDirection_Row As Boolean = True) As String
Dim i As Long

Get_CellValue3 = ""
If bDirection_Row = True Then

For i = LBound(m_varAry, 2) To UBound(m_varAry, 2) Step 1
If strSearch_Target = CStr(m_varAry(lSearch_POS, i)) Then
Get_CellValue3 = CStr(m_varAry(lReturn_POS, i))
Exit Function
End If
Next i

Else

For i = LBound(m_varAry, 1) To UBound(m_varAry, 1) Step 1
If strSearch_Target = CStr(m_varAry(i, lSearch_POS)) Then
Get_CellValue3 = CStr(m_varAry(i, lReturn_POS))
Exit Function
End If
Next i

End If

End Function

'**********************************************************************************************

'検索文字列を開始から終了の間から見つける(シート内から)

Public Function Search_CellNo(ByVal varTarget As Variant, ByVal lLineNo As Long, _
Optional ByVal bSearch_Direction_Row As Boolean = True) As Long

Dim rng As Range
With m_wsSheet
If bSearch_Direction_Row = True Then
Set rng = .Range(.Cells(1, lLineNo), .Cells(m_lRow_Last, lLineNo))
Else
Set rng = .Range(.Cells(lLineNo, 1), .Cells(lLineNo, m_lCol_Last))
End If
End With
On Error Resume Next
Search_CellNo = -1
Search_CellNo = WorksheetFunction.Match(varTarget, rng, 0)
On Error GoTo 0 '発生しているエラーをクリア
Set rng = Nothing

End Function

'**********************************************************************************************

'Variant配列からライン番号取得

Public Function Search_CellNo2(ByVal strSearch_Target As String, ByVal lSearch_POS As Long, _
Optional ByVal bDirection_Row As Boolean = True, _
Optional ByVal bSearch_Top As Boolean = True) As Long
Dim i As Long

Search_CellNo2 = -1
'先端から検索
If bSearch_Top = True Then
If bDirection_Row = True Then

For i = LBound(m_varAry, 2) To UBound(m_varAry, 2) Step 1
If strSearch_Target = CStr(m_varAry(lSearch_POS, i)) Then
Search_CellNo2 = i
Exit Function
End If
Next i

Else

For i = LBound(m_varAry, 1) To UBound(m_varAry, 1) Step 1
If strSearch_Target = CStr(m_varAry(i, lSearch_POS)) Then
Search_CellNo2 = i
Exit Function
End If
Next i

End If
'終端から検索
Else
If bDirection_Row = True Then

For i = UBound(m_varAry, 2) To LBound(m_varAry, 2) Step -1
If strSearch_Target = CStr(m_varAry(lSearch_POS, i)) Then
Search_CellNo2 = i
Exit Function
End If
Next i

Else

For i = UBound(m_varAry, 1) To LBound(m_varAry, 1) Step -1
If strSearch_Target = CStr(m_varAry(i, lSearch_POS)) Then
Search_CellNo2 = i
Exit Function
End If
Next i

End If
End If

End Function

'**********************************************************************************************

'Variant配列からライン番号取得(検索対象2つ)

Public Function Search_CellNo2_Double(ByVal strTarget1 As String, ByVal strTarget2 As String, _
ByVal lPOS1 As Long, ByVal lPOS2 As Long, _
Optional ByVal bDirection_Row As Boolean = True, _
Optional ByVal bSearch_Top As Boolean = True) As Long
Dim i As Long

Search_CellNo2_Double = -1
'先端から検索
If bSearch_Top = True Then
If bDirection_Row = True Then

For i = LBound(m_varAry, 2) To UBound(m_varAry, 2) Step 1
If strTarget1 <> CStr(m_varAry(lPOS1, i)) Then GoTo CONTINUE_1
If strTarget2 <> CStr(m_varAry(lPOS2, i)) Then GoTo CONTINUE_1
Search_CellNo2_Double = i
Exit Function
CONTINUE_1:
Next i

Else

For i = LBound(m_varAry, 1) To UBound(m_varAry, 1) Step 1
If strTarget1 <> CStr(m_varAry(i, lPOS1)) Then GoTo CONTINUE_2
If strTarget2 <> CStr(m_varAry(i, lPOS2)) Then GoTo CONTINUE_2
Search_CellNo2_Double = i
Exit Function
CONTINUE_2:
Next i

End If
'終端から検索
Else
If bDirection_Row = True Then

For i = UBound(m_varAry, 2) To LBound(m_varAry, 2) Step -1
If strTarget1 <> CStr(m_varAry(lPOS1, i)) Then GoTo CONTINUE_3
If strTarget2 <> CStr(m_varAry(lPOS2, i)) Then GoTo CONTINUE_3
Search_CellNo2_Double = i
Exit Function
CONTINUE_3:
Next i

Else

For i = UBound(m_varAry, 1) To LBound(m_varAry, 1) Step -1
If strTarget1 <> CStr(m_varAry(i, lPOS1)) Then GoTo CONTINUE_4
If strTarget2 <> CStr(m_varAry(i, lPOS2)) Then GoTo CONTINUE_4
Search_CellNo2_Double = i
Exit Function
CONTINUE_4:
Next i

End If
End If

End Function

'**********************************************************************************************

'セルの結合・解除

'bAcross 選択範囲のセルを行ごとに結合するフラグ
'bMerge 結合フラグ (true 結合 false 解除)

Public Sub MergeCell(ByVal lRowST As Long, ByVal lColST As Long, ByVal lRowED As Long, ByVal lColED As Long, _
Optional ByVal bAcross As Boolean = False, Optional ByVal bMerge As Boolean = True)

Dim rng As Range
Dim bFlag As Boolean
bFlag = False
With m_wsSheet
Set rng = .Range(.Cells(lRowST, lColST), .Cells(lRowED, lColED))
End With
If bMerge = True Then
If Application.DisplayAlerts = True Then
bFlag = True
Application.DisplayAlerts = False
End If
Call rng.Merge(bAcross)
If bFlag = True Then Application.DisplayAlerts = True
Else
Call rng.UnMerge
End If

End Sub

'**********************************************************************************************

'罫線を引く

Public Sub Draw_RuledLine(ByVal lRowST As Long, ByVal lColST As Long, ByVal _
lRowED As Long, ByVal lColED As Long, _
Optional ByVal LS As XlLineStyle = xlContinuous, _
Optional ByVal BW As XlBorderWeight = xlThin, _
Optional ByVal CI As XlColorIndex = xlAutomatic)

Dim rng As Range
With m_wsSheet
Set rng = .Range(.Cells(lRowST, lColST), .Cells(lRowED, lColED))
End With
With rng.Borders
.LineStyle = LS
.Weight = BW
.ColorIndex = CI
End With

End Sub

'**********************************************************************************************

'罫線(上部)を引く

Public Sub Draw_RuledLine_Top(ByVal lRowST As Long, ByVal lColST As Long, _
ByVal lRowED As Long, ByVal lColED As Long, _
Optional ByVal LS As XlLineStyle = xlContinuous, _
Optional ByVal BW As XlBorderWeight = xlThin, _
Optional ByVal CI As XlColorIndex = xlAutomatic)

Dim rng As Range
With m_wsSheet
Set rng = .Range(.Cells(lRowST, lColST), .Cells(lRowED, lColED))
End With
With rng.Borders(xlEdgeTop)
.LineStyle = LS
.Weight = BW
.ColorIndex = CI
End With

End Sub

'**********************************************************************************************

'罫線(左側)を引く

Public Sub Draw_RuledLine_Left(ByVal lRowST As Long, ByVal lColST As Long, _
ByVal lRowED As Long, ByVal lColED As Long, _
Optional ByVal LS As XlLineStyle = xlContinuous, _
Optional ByVal BW As XlBorderWeight = xlThin, _
Optional ByVal CI As XlColorIndex = xlAutomatic)

Dim rng As Range
With m_wsSheet
Set rng = .Range(.Cells(lRowST, lColST), .Cells(lRowED, lColED))
End With
With rng.Borders(xlEdgeLeft)
.LineStyle = LS
.Weight = BW
.ColorIndex = CI
End With

End Sub

'**********************************************************************************************

'罫線(内側)を引く

Public Sub Draw_RuledLine_Inside(ByVal lRowST As Long, ByVal lColST As Long, ByVal lRowED As Long, ByVal lColED As Long, _
Optional ByVal LS As XlLineStyle = xlContinuous, Optional ByVal BW As XlBorderWeight = xlThin, _
Optional ByVal CI As XlColorIndex = xlAutomatic)

Dim rng As Range
With m_wsSheet
Set rng = .Range(.Cells(lRowST, lColST), .Cells(lRowED, lColED))
End With
With rng.Borders(xlInsideHorizontal)
.LineStyle = LS
.Weight = BW
.ColorIndex = CI
End With
With rng.Borders(xlInsideVertical)
.LineStyle = LS
.Weight = BW
.ColorIndex = CI
End With

End Sub

'**********************************************************************************************

'罫線(外枠)を引く

Public Sub Draw_RuledLine_OutFrame(ByVal lRowST As Long, ByVal lColST As Long, ByVal lRowED As Long, ByVal lColED As Long, _
Optional ByVal LS As XlLineStyle = xlContinuous, Optional ByVal BW As XlBorderWeight = xlThin, _
Optional ByVal CI As XlColorIndex = xlAutomatic)

Dim rng As Range
With m_wsSheet
Set rng = .Range(.Cells(lRowST, lColST), .Cells(lRowED, lColED))
End With
Call rng.BorderAround(LS, BW, CI)

End Sub

'**********************************************************************************************

'セル背景色変更

Public Sub Change_CellBackColor(ByVal lRowST As Long, ByVal lColST As Long, ByVal lRowED As Long, _
ByVal lColED As Long, ByVal lColor As Long, _
Optional ByVal lFontColor As Long = -1)
Dim rng As Range
With m_wsSheet
Set rng = .Range(.Cells(lRowST, lColST), .Cells(lRowED, lColED))
End With
With rng
.Interior.Color = lColor
If lFontColor <> -1 Then .Font.Color = lFontColor
End With

End Sub

'**********************************************************************************************