質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

90.12%

VBAでのプロパティ型に関するオーバーロード

解決済

回答 2

投稿 編集

  • 評価
  • クリップ 0
  • VIEW 480

yuujiMotoki

score 33

VBAでコレクションクラスを使って、シート上に並んだデータを読み込む関数を書いています。

プロパティが異なるクラスに対する処理のために、同じような関数を書くことになりますが、
型宣言の部分以外は、ルーチンがまったく同じです。

できればオブジェクト指向的に、使い回しをしたいのですが、この場合は関数のオーバーロードなのか、
インターフェイスによる継承なのか分かりませんが、コレクションの中に入れるオブジェクトの型宣言の部分を
汎化するには、どうしたらいいでしょうか?
(他の言語なら、さくっとできるのかもしれませんが、現時点ではアイデアが無くて困っています)

objshtというのが、ワークシートになっており、
この名前で、型宣言を可変にしたいです

(clsCollection)

'項目を読み込むクラス
Public Function 項目読込(ByVal objsht As Variant) As Collection
    Dim ItemList As New Collection
    Dim endflg As Boolean
    row = 2

    Do
    With New clsSchedule
        Set .WST = objsht
        endflg = .セル読込(row)
        ItemList.Add .Self
        row = row + 1
    End With
    Loop While endflg = True

    Set 項目読込 = ItemList

End Function
(clsSchedule)

Option Explicit
Public ID As Long
Public 項目  As String
Public 詳細項目  As String
Public 作業分類 As Long
Public ステータス As Boolean
Public 計画者 As String
Public 担当者 As String
Public 予定開始時間 As Date
Public 予定終了時間 As Date
Public 実績開始時間 As Date
Public 実績終了時間 As Date
Public 実績工数 As Long
Public 投入 As Long
Public 取出 As Long
Public ウェイト As Long

Const MAX_COLUMN = 20
Private DST As Worksheet

Public Property Get Self() As clsSchedule
  Set Self = Me
End Property


Public Function セル読込(ByVal row As Long) As Boolean
    If DST.Cells(row, 1) = "" And DST.Cells(row, 2) = "" Then
        セル読込 = False
        Exit Function
    End If

    With New clsStrage
        .value(row, 1, MAX_COLUMN) = 0
        Set .WST = DST

ID = .DATA
項目 = .DATA
詳細項目 = .DATA
作業分類 = .DATA
ステータス = .DATA
計画者 = .DATA
担当者 = .DATA
予定開始時間 = .DATA
予定終了時間 = .DATA
実績開始時間 = .DATA
実績終了時間 = .DATA
実績工数 = .DATA

投入 = .DATA
取出 = .DATA

    End With

    If ウェイト < 1 Then ウェイト = 1
    セル読込 = True

End Function

Property Set WST(ByVal newVal As Worksheet)
    Set DST = newVal
End Property

自己解決方法

一応、自分なりに書いてみましたが、これでもかなり無駄が多いコードです。

Option Explicit
Private row As Integer

'項目を読み込むクラス
Public Function 読込(ByVal objsht As Variant) As Collection
    Dim ItemList As New Collection
    Dim endflg As Boolean

    Debug.Print objsht.name

    row = 2

Do

    Select Case objsht.name

    Case "チャートクエリ"
      With New clsSchedule
              Set .WST = objsht
        endflg = .セル読込(row)
        ItemList.add .Self
        row = row + 1
      End With

    Case "ビルド"
      With New clsPeople
            Set .WST = objsht
        endflg = .セル読込(row)
        ItemList.add .Self
        row = row + 1
    End With

    Case "品種"
      With New clsSchedule
            Set .WST = objsht
        endflg = .セル読込(row)
        ItemList.add .Self
        row = row + 1
    End With

  End Select

Loop While endflg = True

    Set 読込 = ItemList

End Function
  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 2

+1

あまりにも使う人が少ない機能ですが「Implements」というものがあります。
一応インターフェースらしき機能です。Implementsしたオブジェクトは
1.Publicのすべての実装を強制されます。1つでも未定義の場合コンパイルでエラーを吐きます。
2.Implements元のオブジェクトにダウンキャストできるようになります。

というわけでこんな感じでしょうか。ExcelVBAは全く触らないので感覚で書いています。

(clsIData)
Option Explicit

' インターフェース専用なので中身なし、書いても今回は使えません。
Public Function セル読込(ByVal row As Long) As Boolean

End Function

Public Property Get Self() As Object

End Property

Public Property Set WST(ByVal newVal As Worksheet)

End Property

clsScheduleはclsIDataをImplementsします

(clsSchedule)
Option Explicit

' ######################
' ここ!
' ######################
Implements clsIData

Public ID As Long
Public 項目  As String
Public 詳細項目  As String
Public 作業分類 As Long
Public ステータス As Boolean
Public 計画者 As String
Public 担当者 As String
Public 予定開始時間 As Date
Public 予定終了時間 As Date
Public 実績開始時間 As Date
Public 実績終了時間 As Date
Public 実績工数 As Long
Public 投入 As Long
Public 取出 As Long
Public ウェイト As Long

Const MAX_COLUMN = 20
Private DST As Worksheet

Private Property Get clsIData_Self() As Object
  Set clsIData_Self = Me
End Property

Private Property Set clsIData_WST(ByVal newVal As Excel.Worksheet)
    Set DST = newVal
End Property

Private Function clsIData_セル読込(ByVal row As Long) As Boolean
    If DST.Cells(row, 1) = "" And DST.Cells(row, 2) = "" Then
        clsIData_セル読込 = False
        Exit Function
    End If

    With New clsStrage
        .Value(row, 1, MAX_COLUMN) = 0
        Set .WST = DST

        ID = .Data
        項目 = .Data
        詳細項目 = .Data
        作業分類 = .Data
        ステータス = .Data
        計画者 = .Data
        担当者 = .Data
        予定開始時間 = .Data
        予定終了時間 = .Data
        実績開始時間 = .Data
        実績終了時間 = .Data
        実績工数 = .Data

        投入 = .Data
        取出 = .Data

    End With

    If ウェイト < 1 Then ウェイト = 1
    clsIData_データ読込 = True
End Function


Implementsすると元オブジェクトのPublicをすべて実装しなければなりません。
メソッド名などは「clsIData_セル読込」みたいな感じで先頭にクラス名が付きます。

使うときはこうなります。

Option Explicit
Private row As Integer

'項目を読み込むクラス
Public Function 読込(ByVal objsht As Variant) As Collection
    Dim ItemList As New Collection
    Dim endflg As Boolean
    ' ダウンキャスト用
    Dim Dataobj as clsIData

    Debug.Print objsht.name

    row = 2

Do
    ' 一応気持ち悪いので
    set Dataobj = Nothing

    Select Case objsht.name

    Case "チャートクエリ","品種"
      ' 代入できる
      Set Dataobj = New clsSchedule
      ' 元オブジェクトにキャストするとclsScheduleのPublicにアクセス可能
      'Dim sch as clsSchedule
      'set sch = Dataobj.Self
      'sch.項目 = "test"
    Case "ビルド"
      ' claPeopleがclsIDataをImplementsしていればこれも入る
      Set Dataobj = New clsPeople
  End Select

    ' それぞれの持つオブジェクトのWST,セル読込で実行可能
    With Dataobj
        Set .WST = objsht
        endflg = .セル読込(row)
        ItemList.add .Self
    End With
    row = row + 1
Loop While endflg = True

    Set 読込 = ItemList

End Function

ぶっちゃけると「VBAでここまでやりますか…」ってなります。
特にすべての実装を強制されるのは思っているよりもきつい(きつかった)です。委譲ができないので。
ダック・タイピングの方がはるかに簡単で「VBAらしい」としている人が多いですね。
インターフェースを直すとなったら大変ですがバグは出にくくなると思います。

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

checkベストアンサー

0

以下のようなプロシージャを作成するのが一番手っ取り早そうです。

Public Function NewMyClass(ByVal objsht As Excel.Worksheet) As Object
    Select Case objsht.Name
        Case "チャートクエリ", "品種"
            Set NewMyClass = New clsSchedule
        Case "ビルド"
            Set NewMyClass = New clsPeople
        Case Else
            Err.Raise 5
    End Select

    Set NewMyClass.WST = objsht

End Function

使用例

Public Function 項目読込2(ByVal objsht As Variant) As Collection
    Dim ItemList As New Collection
    Dim endflg As Boolean
    Row = 2

    Do
        With NewMyClass(objsht)
            endflg = .セル読込(Row)
            ItemList.Add .Self
            Row = Row + 1
        End With
    Loop While endflg = True

    Set 項目読込2 = ItemList

End Function

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 90.12%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

同じタグがついた質問を見る