HOMEへ

クラスシート======================================================

Option Explicit

Enum eFieldSheet1
    eId = 1
    eName
    eGender
    eBirthday
    eActive
End Enum

Public Persons As Collection
Public MaxId As Long

'**
' テーブルのデータをPersonsコレクションとして格納
'
' @param myRange{Range}
'
Public Sub LoadData()
    Set Persons = New Collection

    With ListObjects(1)

        Dim myRow As ListRow
        For Each myRow In .ListRows
            Dim p As Person: Set p = New Person
            p.Initialize myRow.Range
            Persons.Add p, CStr(p.Id)
        Next myRow
    
        MaxId = .ListRows.Count
    
    End With

End Sub

'**
' Personsコレクションのデータをテーブルに展開
'
'
Public Sub ApplyData()

    With ListObjects(1)
        If .ListRows.Count > 0 Then
            .DataBodyRange.EntireRow.Delete
        End If
        
        Dim p As Person
        For Each p In Persons
            .ListRows.Add.Range = Array(p.Id, p.Name, p.Gender, p.Birthday, p.Active)
        Next p
    
        MaxId = .ListRows.Count
    
    End With

End Sub

'**
' PersonsコレクションのPersonオブジェクトを更新
'
' @param p{Person} 更新するPersonオブジェクト

Public Sub UpdatePerson(p As Person)

    With Persons(p.Id)
        .Id = p.Id
        .Name = p.Name
        .Gender = p.Gender
        .Birthday = p.Birthday
        .Active = p.Active
    End With

    Call ApplyData

End Sub

'**
' PersonsコレクションのPersonオブジェクトを追加
'
' @param p{Person} 追加するPersonオブジェクト

Public Sub AddPerson(p As Person)

    Persons.Add p, CStr(p.Id)
    Call ApplyData

End Sub

'**
' Studentクラス
'

Private mID As String
Private mName As String
Private mAge As Long
Private mMobile As String

Public Property Let ID(ByVal vID As String)

    mID = vID

End Property

Public Property Get ID() As String

    ID = mID

End Property

Public Property Let Name(ByVal vName As String)

    mName = vName

End Property

Public Property Get Name() As String

    Name = mName

End Property

Public Property Let Age(ByVal vAge As Long)

    mAge = vAge

End Property

Public Property Get Age() As Long

    Age = mAge

End Property

Public Property Let Mobile(ByVal vMobile As String)

    mMobile = vMobile

End Property

Public Property Get Mobile() As String

    Mobile = mMobile

End Property

'**
' Studentsクラス
'
Option Explicit

Private mItems As Collection
Private mItemDictionary As Object

Private Sub Class_Initialize()
    Set mItems = New Collection
    Set mItemDictionary = CreateObject("Scripting.Dictionary")
End Sub

Private Sub Class_Terminate()
    Set mItems = Nothing
    Set mItemDictionary = Nothing
End Sub

Public Sub Add(ByVal vID As String, ByVal vName As String, ByVal vAge As Long, ByVal vMobile As String)

    Dim vStudent As Student

    mItemDictionary.Add Key:=vID, Item:=mItems.Count + 1

    Set vStudent = New Student
'    mItems.Add vStudent
    With vStudent
        .ID = vID
        .Name = vName
        .Age = vAge
        .Mobile = vMobile
    End With
    mItems.Add vStudent

    Set vStudent = Nothing

End Sub

Public Function SearchItemIndex(ByVal vID As String) As Variant
    
    SearchItemIndex = False
    If mItemDictionary.Exists(vID) Then
        SearchItemIndex = mItemDictionary.Item(vID)
    End If

End Function

Public Property Get Item(ByVal Index As Long) As Student
    Set Item = mItems.Item(Index)
End Property

<標準モジュール>
Public Sub main()

    Dim tBook As Workbook
    Dim sSheet2 As Worksheet
    Dim searchArea As Range
    Dim r As Long

    Dim clsPersons As Persons
    Set clsPersons = New Persons

    Set tBook = ThisWorkbook
    With tBook
        Set sSheet2 = .Worksheets("Sheet2")
    End With

    With sSheet2.Range("A3").CurrentRegion
        Set searchArea = .Resize(.Rows.Count - 1).Offset(1)
    End With

    For r = 1 To searchArea.Rows.Count
        If searchArea.Rows(r).Range("C1").Value >= 30 Then
            With searchArea.Rows(r)
                clsPersons.Add .Range("A1").Value, .Range("B1").Value, .Range("C1").Value, .Range("D1").Value
            End With
        End If
    Next r

    Dim index As Long
    
    index = clsPersons.getIndex("ASC1240")
    If index Then
        MsgBox clsPersons.Item(index).name
    Else
        MsgBox "見つかりません"
    End If

End Sub


Option Explicit
Private dicItem As Object
Private collItem As Collection

Private Sub Class_Initialize()
    
    Set dicItem = CreateObject("Scripting.Dictionary")
    Set collItem = New Collection

End Sub

Public Sub Add(id As String, name As String, age As Long, tel As String)

    dicItem.Add id, collItem.Count + 1

    Dim psn As person
    Set psn = New person

    With psn
        .id = id
        .name = name
        .age = age
        .tel = tel
    End With
    collItem.Add psn, psn.id

    Set psn = Nothing

End Sub

Public Function getIndex(id As String) As Long

    getIndex = 0
    
    If dicItem.Exists(id) Then
        getIndex = dicItem.Item(id)
    End If

End Function

Public Property Get Item(index As Long) As person

    Set Item = collItem.Item(index)

End Property


Option Explicit

Private cID As String
Private cName As String
Private cAge As Long
Private cTel As String

Public Property Let id(mId As String)
    cID = mId
End Property

Public Property Get id() As String
    id = cID
End Property

Public Property Let name(mName As String)
    cName = mName
End Property

Public Property Get name() As String
    name = cName
End Property

Public Property Let age(mAge As String)
    cAge = mAge
End Property

Public Property Get age() As String
    age = cAge
End Property

Public Property Let tel(mTel As String)
    cTel = mTel
End Property

Public Property Get tel() As String
    tel = cTel
End Property