アットウィキロゴ
Option Explicit

Private Type BookData
    t_WorkBook As Workbook
    t_WorkSheet As Worksheet
    t_Range As range
    t_LastRow As Long
    t_LastColumn As Integer
    t_MaxRow As Long
    t_MaxColumn As Integer
End Type

Private m_type As BookData

Private Property Set Workbook(ByRef r_workbook As Workbook)
    Set m_type.t_WorkBook = r_workbook
End Property

Public Property Get Workbook() As Workbook
    Set Workbook = m_type.t_WorkBook
End Property

Private Property Set Worksheet(ByRef r_worksheet As Worksheet)
    Set m_type.t_WorkSheet = r_worksheet
End Property

Public Property Get Worksheet() As Worksheet
    Set Worksheet = m_type.t_WorkSheet
End Property

Private Property Let LastRow(ByRef last_row As Long)
    m_type.t_LastRow = last_row
End Property

Private Property Get LastRow() As Long
    LastRow = m_type.t_LastRow
End Property

Private Property Let LastColumn(ByRef last_column As Integer)
    m_type.t_LastColumn = last_column
End Property

Private Property Get LastColumn() As Integer
    LastColumn = m_type.t_LastColumn
End Property

Private Property Let MaxRow(ByRef max_row As Long)
    m_type.t_MaxRow = max_row
End Property

Public Property Get MaxRow() As Long
    MaxRow = m_type.t_MaxRow
End Property

Private Property Let MaxColumn(ByRef max_column As Integer)
    m_type.t_MaxColumn = max_column
End Property

Public Property Get MaxColumn() As Integer
    MaxColumn = m_type.t_MaxColumn
End Property

Public Function GetLastRow(ByRef r_range As range) As Long
    LastRow = Cells(r_range.Worksheet.Cells.Rows.Count, r_range.Column).End(xlUp).Row
    GetLastRow = LastRow
End Function

Public Function GetLastColumn(ByRef r_range As range) As Integer
    LastColumn = Cells(r_range.Row, r_range.Worksheet.Cells.Columns.Count).End(xlToLeft).Column
    GetLastColumn = LastColumn
End Function

Public Function CheckActiveWorkBook(ByRef r_workbook As Workbook) As Boolean
'    Debug.Print "CheckWorkBook: " & r_workbook.Name & vbCrLf & "NowWorkBook: " & Application.ActiveWorkbook.Name
    CheckActiveWorkBook = Application.ActiveWorkbook Is r_workbook
End Function

Public Function CheckActiveSheet(ByRef r_sheet As Worksheet) As Boolean
'    Debug.Print "CheckSheet: " & r_sheet.Name & vbCrLf & "NowSheet: " & Application.ActiveSheet.Name
    CheckActiveSheet = Application.ActiveSheet Is r_sheet
End Function

Public Function SetWorkBook(ByRef r_book As Workbook) As Boolean
    Dim status As Boolean
    status = False
    If r_book Is Application.Workbooks.Item(r_book.Name) Then
        Set m_type.t_WorkBook = r_book
        Set m_type.t_WorkSheet = m_type.t_WorkBook.Sheets(1)
        Set m_type.t_Range = m_type.t_WorkSheet.Cells(1, 1)
        MaxRow = m_type.t_WorkSheet.Cells.Rows.Count
        MaxColumn = m_type.t_WorkSheet.Cells.Columns.Count
        status = True
    End If
    SetWorkBook = status
End Function

Public Function GetRow(ByRef r_worksheet As Worksheet, ByRef r_rowNumber As Long) As range
    Dim s_range As range
    If 1 < r_rowNumber And r_rowNumber < MaxRow Then
        Set s_range = r_worksheet.Rows(r_rowNumber)
    End If
    Set GetRow = s_range
End Function

Public Function GetColumn(ByRef r_worksheet As Worksheet, ByRef r_columnNumber As Integer) As range
    Dim s_range As range
    If 1 <= r_columnNumber And r_columnNumber <= MaxColumn Then
        Set s_range = r_worksheet.Columns(r_columnNumber)
    End If
    Set GetColumn = s_range
End Function

Public Function GetDuplicateRow(ByRef r_worksheet As Worksheet, ByRef r_columnNumber As Integer, ByRef r_keyword As String) As Collection
    Dim d_collection As New Collection
    Dim index As Long
    Dim result As range
    If 1 <= r_columnNumber And r_columnNumber <= MaxRow Then
        index = 1
            Set result = r_worksheet.range(Cells(index, r_columnNumber), Cells(MaxRow, r_columnNumber)).Find(What:=r_keyword, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, MatchByte:=True, SearchFormat:=False)
        If Not result Is Nothing Then
'            Do Until index = result.address
'                If Not result Is Nothing Then
'                    Debug.Print result.address
'                    Set result = Nothing
'                    Exit Do
'                End If
'            r_worksheet.Cells(index, r_columnNumber).Find(What:=r_keyword,
'            Set s_range = r_worksheet.Rows(r_rowNumber)
'            Loop
'        End If
    End If
    Set GetDuplicateRow = Nothing
End Function
最終更新:2012年01月18日 03:12