PersonクラスとPersonsクラス

PersonクラスとPersonsクラス

TwitterのTL上で見かけたので、中途半端に乗っかってみる。

準備

Excelのブックに二つのワークシートを準備して、片や「MasterData」（オブジェクト名は「Sh01Master」）、こなた「Extracted」（オブジェクト名は「Sh02Extracted」）と名づけた。

それぞれのシートは次のとおり。

また、標準モジュール三つ（「M00PublicVariables」、「M01ModuleMain」、「XlsCommon」）、クラスモジュール二つ（「Person」、「Persons」）を置いた。

プロジェクト・エクスプローラーは、

この状態。

コード

ひとまず、モジュールごとにコードを示す。

シートモジュール

Sh01Masterモジュール

Option Explicit

'Constants'
Public Enum Sh01InfoColumn
  sh01icName = 1
  sh01icBirthPlace
  sh01icBelongsTo
  sh01icEntranceSide
  sh01icWrestlerRank
End Enum

Public Property Get NameList() As Range
  Dim rng As Range
  Set rng = Me.Range("A1").CurrentRegion
  With rng
    Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, _
                                   .Columns.Count)
  End With
  Set NameList = rng
End Property

シート上の表の列番号を指す列挙体と、表の正味のデータ部分を返すプロパティ（NameList）を置いた。

Sh02Extractedモジュール

Option Explicit

Public Property Get NameList() As Range
  Dim rng As Range
  Set rng = Me.Range("A1").CurrentRegion
  rng.Borders.LineStyle = xlNone
  Set NameList = rng
End Property

Public Property Get StartCell() As Range
  Dim startRow As Long
  startRow = Me.Cells(Me.Rows.Count, 1).End(xlUp).Row + 1
  Set StartCell = Me.Cells(startRow, 1)
End Property

A1セルを基準とするアクティブセル領域を取得するプロパティ（NameList）と、その領域の直後のセルを取得するプロパティ（StartCell）を置いた。

このセル範囲には、後述するPersonオブジェクトのNameプロパティの値の転記先として用いる。

クラスモジュール

Personクラス

Option Explicit

'Module Level Variables'
Private name_ As String
Private birthPlace_ As String
Private belongsTo_ As String

'Properties'
Public Property Get Name() As String
  Name = name_
End Property

Public Property Get BirthPlace() As String
  BirthPlace = birthPlace_
End Property

Public Property Get BelongsTo() As String
  BelongsTo = belongsTo_
End Property

'Constructor'
Public Sub init(ByVal name__ As String, _
                ByVal birthPlace__ As String, _
                ByVal belongsTo__ As String)
  name_ = name__
  birthPlace_ = birthPlace__
  belongsTo_ = belongsTo__
End Sub

'Methods'
Public Sub introduceMyself(ByVal entranceSide As String, _
                           ByVal wrestlerRank As String)
  Call XlsCommon.makeUserSick( _
                   entranceSide & " " & wrestlerRank & " " & _
                   name_ & vbCrLf & _
                   birthPlace_ & "出身 " & belongsTo_)
End Sub

三つのプロパティ（「Name」、「BirthPlace」、「BelongsTo」）とコンストラクタ、後は自己紹介メソッド（introduceMyself）を置いた。

追記

改めて見直すと、これはうまくないなあ。

PersonクラスからXlsCommonモジュールのメソッドを呼び出しているのでは、依存関係ができてしまっている。どうせmakeUserSickメソッドしか使わないのだから、Personクラス内に封印してしまわないと……。

またヒマなときに修正します。

*****追記ここまで*****

Personsクラス

Option Explicit

'Module Level Variables'
Private items_ As New Collection

'Properties'
Public Property Get Items() As Collection
  Set Items = items_
End Property

'Methods'
Public Sub addItem(ByVal name__ As String, _
                   ByVal birthPlace__ As String, _
                   ByVal belongsTo__ As String)
  Dim newPerson As New Person
  Call newPerson.init(name__, birthPlace__, belongsTo__)
  Call items_.Add(newPerson)
End Sub

Public Sub removeItem(ByVal indexNumber As Long)
  Call items_.Remove(indexNumber)
End Sub

Public Sub extractNames(ByVal startFrom As Range)
  Dim i As Long
  Dim ar() As String
  ReDim ar(1 To items_.Count, 1 To 1)
  For i = 1 To items_.Count
    ar(i, 1) = items_(i).Name
  Next
  Dim targetRange As Range
  Set targetRange = startFrom.Resize(items_.Count, 1)
  targetRange.Value = ar
End Sub

Personインスタンスを格納するCollection型のプロパティ（「Items」）を置いた。

あと、Personインスタンスを追加するaddItemメソッド、削除するremoveItemメソッドに加え、指定したセルを先頭に、Itemに格納されているPersonインスタンスのNameプロパティの値をずらり並べて書き込むextractNamesメソッドを置いた。

標準モジュール

M00PublicVariablesモジュール

Option Explicit

'Public Variable'
Public Persons As New Persons

Personsオブジェクトは一つで良いので、Public指定で置いておく。これで、いつでもどこからでも使える。

M01ModuleMainモジュール

Option Explicit

Private Sub testPersonClass()
  Dim i As Long
  With Sh01Master.NameList
    For i = 1 To .Rows.Count
      Call Persons.addItem(.Cells(i, sh01icName).Value, _
                           .Cells(i, sh01icBirthPlace).Value, _
                           .Cells(i, sh01icBelongsTo).Value)
    Next
    For i = 1 To Persons.Items.Count
      Call Persons.Items(i).introduceMyself( _
                           .Cells(i, sh01icEntranceSide).Value, _
                           .Cells(i, sh01icWrestlerRank).Value)
    Next
  End With
  Call Persons.extractNames(Sh02Extracted.StartCell)
  Sh02Extracted.NameList.Borders.LineStyle = xlContinuous
  Set Persons = Nothing
End Sub

Personクラス、Personsクラス使用実験用コード。

同じ変数iを二つの異なる用途に使い回しているところはスルーでｗ

一つ目のForループで、「MasterData」シート上のデータ（笑）に基づいてPersonインスタンスをPersonsクラスのItemsにぶち込む。

二つ目のForループでは、Itemsコレクションの中身を取り出して、それぞれintroduceMyselfメソッドを実行。

最後に、PersonsクラスのextractNamesメソッドを用いて、それぞれのPersonインスタンスのNameプロパティの値を「Extracted」シートのA列に転記する。

XlsCommonモジュール

※必要な部分のみ掲載します。

'Constants'
Private Const MAKE_USER_SICK_2013 As String = _
              "       ＿＿＿＿＿＿＿" & vbCrLf & _
              "   ／　　　　　　　＼" & vbCrLf & _
              "／　／・＼　　／・＼　＼" & vbCrLf & _
              "|　　￣￣　 　￣￣　　 |　　　ち～んｗ" & vbCrLf & _
              "|　　　　（＿人＿）　  |" & vbCrLf & _
              "|　　　　　＼　 |　　　|" & vbCrLf & _
              "＼　　　　　＼_|　　／"

Private Const MAKE_USER_SICK_2010 As String = _
              "    　＿＿＿＿＿＿＿" & vbCrLf & _
              "　／　　　　　　　        ＼ " & vbCrLf & _
              "／　／・＼　　／・＼  　  ＼" & vbCrLf & _
              "|　　￣￣　　　￣　　　      |　ち～んｗ" & vbCrLf & _
              "|　　　　（＿人＿）　　       |" & vbCrLf & _
              "|　　　　　＼ 　   |      　   |" & vbCrLf & _
              "＼　　　　 　＼＿|　      ／"

Public Sub makeUserSick(Optional ByVal msg As String)
  Dim ver As String
  ver = Application.Version
  Dim str As String
  Select Case ver
    Case "14.0"
      str = MAKE_USER_SICK_2010
    Case "15.0"
      str = MAKE_USER_SICK_2013
    Case "16.0"
      str = MAKE_USER_SICK_2013
    Case Else
      str = MAKE_USER_SICK_2010
  End Select
  If msg = "" Then msg = "涙拭けよｗｗｗ"
  MsgBox msg & vbCrLf & str
End Sub

当ブログではおなじみ、makeUserSickメソッド。

単にメッセージを表示するだけだが、無駄にむかつく顔文字を添える。

実験

「Extracted」シート上にコマンドボタンを置き、M01ModuleMainモジュールのtestPersonClassメソッドを登録して実行する。

こんな感じ。

おわりに

意外と楽しかった。