Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


5485 / 13644 ツリー ←次へ | 前へ→

【50394】表の仕様のカプセル化 りった 07/7/23(月) 16:24 質問[未読]
【50403】Re:表の仕様のカプセル化 neptune 07/7/23(月) 22:25 発言[未読]
【50416】Re:表の仕様のカプセル化 りった 07/7/24(火) 17:38 質問[未読]
【50417】Re:表の仕様のカプセル化 neptune 07/7/24(火) 18:15 回答[未読]
【50518】Re:表の仕様のカプセル化 りった 07/7/30(月) 17:24 お礼[未読]

【50394】表の仕様のカプセル化
質問  りった  - 07/7/23(月) 16:24 -

引用なし
パスワード
   いつもお世話になっております。
表の仕様(どこの列に何のデータが入っている等)の情報とプログラムを分離する為に下記の仕組みを考えました。
チーム内に展開し使用したいのですが、あんまり自信ないので良くない箇所など後指摘頂ければ助かります。
運用してしまってからだと変更工数が大きいので...

背景:
 各種表(10数個)を元に色々な集計を行っています。
 何を集計するかは頻繁に変わります。

目的:
 テーブルの使用をカプセル化し、既存のテーブルで
 新たな集計を行う際にはテーブルの仕様を考えずに
 コーディングしたい

モジュールの構成
 ・試験用ルートモジュール
  テスト用のメインです。
 ・Rバグ票
  1レコードのクラスです。
  テーブルの仕様に依存します。
 ・Rバグ票data
  Rバグ票のクラス変数を入れる
 ・TblFRows
 ・クラス変数

その他
 ・テーブル追加の作業が面倒です。もう少し減らしたい。
 ・実際には列の数は何十個かあり、20個程度を判定等に使用します。

^^^^^^^^^^^^^^^^^^^^^^^^ 試験用ルートモジュール
Sub classDebug()
 Dim tbl As New TblFRows
 Dim rcd As New Rバグ票
 Dim s As Worksheet
 Dim i As Integer
 Dim cnt As Integer
 initClassData
 Set s = ThisWorkbook.Worksheets("Sheet1")
 tbl.init s.Range("C2")
 rcd.init tbl
 cnt = 0
 For i = 0 To tbl.nRows - 1
  rcd.idx = i
  If rcd.ランク = "A" Then cnt = cnt + 1
 Next
 MsgBox (cnt)
End Sub

^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Rバグ票
Private cData As Rバグ票data
Public tbl As TblFRows
Public idx As Integer

Public Function 管理番号() As Range
 Dim i As Integer
 i = Me.idx
 Set 管理番号 = Me.tbl.sht.Cells(Me.tbl.getRecStartRow(Me.idx), クラス変数.gCD_Rバグ票.myCol管理番号 + Me.tbl.oriCol)
End Function

Public Function ランク() As Range
 Set ランク = Me.tbl.sht.Cells(Me.tbl.getRecStartRow(Me.idx), クラス変数.gCD_Rバグ票.myColランク + Me.tbl.oriCol)
End Function

Public Function init(ByRef t As TblFRows) As Boolean
 Dim myRngTitle As Range
 Dim r As Range
 
 Set Me.tbl = t
 Set r = t.sht.Cells(t.oriRow, t.oriCol)
 Set myRngTitle = t.sht.Range(r, r.Offset(0, t.nCols - 1))
 
 With クラス変数.gCD_Rバグ票
  If Not .idInited Then
   .myColランク = myRngTitle.Find("ランク", , , xlWhole).Column - Me.tbl.oriCol
   .myCol管理番号 = myRngTitle.Find("管理番号", , , xlWhole).Column - Me.tbl.oriCol
   .idInited = True
   .notNullCol = Me.管理番号.Column - Me.tbl.oriCol
   Me.tbl.adjstRowDown (Me.管理番号.Column)
  End If
 End With

 init = True
End Function
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Rバグ票data
Public idInited As Boolean
Public notNullCol As Integer
Public myCol管理番号 As Integer
Public myColランク As Integer
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ TblFRows
Public sht As Worksheet
Public nRows As Integer
Public nCols As Integer
Public oriRow As Integer
Public oriCol As Integer
Public notNullCol As Integer
Public rowsPerRec

Public Function init(ByRef ori As Range) As Boolean
 Set Me.sht = ori.Worksheet
 Me.oriRow = ori.Row
 Me.oriCol = ori.Column
 Me.adjstCol
 Me.notNullCol = 0
End Function

Public Function adjstCol() As Boolean
 Dim r As Range
 Set r = Me.sht.Cells(oriRow, oriCol)
 Me.nCols = r.End(xlToRight).Column - oriCol + 1
 adjstCol = True
End Function

Public Function getRecStartRow(ByVal idx As Integer) As Integer
 getRecStartRow = Me.oriRow + (idx * Me.rowsPerRec) + 1
End Function

Public Function adjstRowDown(ByVal col As Integer) As Boolean
 Dim r As Range
 Set r = Me.sht.Cells(oriRow, col)
 Me.nRows = r.End(xlDown).Row - oriRow
 adjstRowDown = True
End Function

Public Function adjstRowUp(ByVal col As Integer) As Boolean
 Dim r As Range
 Set r = Me.sht.Cells(65536, col)
 Me.nRows = r.End(xlUp).Row - oriRow
 adjstRowUp = True
End Function
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ クラス変数
Public gCD_Rバグ票 As Rバグ票data
Public Sub initClassData()
 Set gCD_Rバグ票 = New Rバグ票data
End Sub

【50403】Re:表の仕様のカプセル化
発言  neptune  - 07/7/23(月) 22:25 -

引用なし
パスワード
   行き掛りですんで、ちょっと書きました。

私のやり方だとこんな感じ
多分VB使いにはこちらの方がなじみ易いと思います。

でも、私なら本当はこんな面倒なことはしません。
Accessを使います。その方が工数は小、処理速度も速いはずです。
Excelにデータがあったとしても、Accessに流し込んだほうが(私には)楽チン
と思います。データの量の増大にも別段心配する必要もないし。

Accessのない環境に配布の必要があるなら、mdbファイルとインターフェイス用に
Excelでも使いますか。

※データを作るのが面倒なんで、ソースを書いたものの全く確認は
してませんので悪しからず。まぁこんな感じという事でお願いします。
'/////////////標準モジュール/////////////
Sub test()
  Dim cls1 As New DatasClass
  
  cls1.AddRecords Worksheets("Sheet1").Range("A2:D10")
  Debug.Print cls1.RecCount
End Sub

'/////////////////DatasClass//////////////
'データ管理用Class
'テーブルの仕様に依存

Private clsRec() As RecordClass
Private mCol As Collection


Private Sub Class_Initialize()
  Set mCol = New Collection
End Sub

'セル範囲を渡し、データをセットしてしまう。
'面倒なので既にセットされた場合の確認は省略してます。
'引数
'pSh :DataTableのセル範囲
Public Function AddRecords(pSh As Range)
Dim i As Long, imax As Long
Dim lcol As Long
Dim r As Long  '行番号

  ReDim clsRec(pSh.Rows.Count)
  r = 0
  For i = 1 To pSh.Rows.Count
    Set clsRec(i) = New RecordClass
    With clsRec(i)
      r = r + 1
      .idInited = pSh.Range(r, lcol).Value
      .notNullCol = pSh.Range(r, lcol + 1).Value
      .ランク = pSh.Range(r, lcol + 2).Value
      .管理番号 = pSh.Range(r, lcol + 3).Value
    End With
    '管理番号をKeyにしてRecordClassのCollectionを作成
    mCol.Add clsRec(i), CStr(clsRec(i).管理番号)
  Next i
End Function

'管理番号を受け取り、該当のレコードの内容を返す
'戻り値は配列変数
'ユーザー定義で返したい場合は標準モジュールにpublicでユーザー定義必要
Public Function GetData(pKanri As Long) As Variant
Dim ret(3) As Long
  With mCol(pKanri)
    ret(0) = .idInited
    ret(1) = .notNullCol
    ret(2) = .管理番号
  End With
  
End Function
'レコード数を返す
Public Function RecCount() As Long
  mCol.Count
End Function
'その他処理に必要な関数を作成

'以下は手抜きしてます
'Classのインスタンスを削除する処理
'Collectionのインスタンスを削除する処理

'/////////////RecordClass///////////Record格納用////////
'テーブルの仕様に依存
Private midInited As Boolean
Private mnotNullCol As Long
Private mCol管理番号 As Long
Private mColランク As Long

Public Property Let idInited(pData As Boolean)
  midInited = pData
End Property
Public Property Get idInited() As Boolean
  idInited = midInited
End Property

Public Property Let notNullCol(pData As Long)
  mnotNullCol = pData
End Property
Public Property Get notNullCol() As Long
  notNullCol = midInited
End Property

Public Property Let 管理番号(pData As Long)
  mCol管理番号 = pData
End Property
Public Property Get 管理番号() As Long
  管理番号 = mCol管理番号
End Property

Public Property Let ランク(pData As Long)
  mColランク = pData
End Property
Public Property Get ランク() As Long
  ランク = mColランク
End Property

【50416】Re:表の仕様のカプセル化
質問  りった  - 07/7/24(火) 17:38 -

引用なし
パスワード
   回答ありがとうございます。

提示頂いたプログラムについて、ご教授下さい。

1.先ずはRecordClassのコレクションを作って、その後好きに料理するってことですか?

2.下記の 2 , 3 は列番号ですか?
>       .ランク = pSh.Range(r, lcol + 2).Value
>       .管理番号 = pSh.Range(r, lcol + 3).Value


尚、アクセス使わない理由は、下記です。
1.VBAで作ったプログラムが多い。
 (過去資産に付け足す形でプログラムすることも多い。)
2.入力帳票、出力帳票がExcelであることが多い。
3.セルの色をつけたりなどもする
4.チーム内にアクセス使える人がいない
 (自分が休みのときにバグるとハマる)
5.自分もアクセスの知識無い

【50417】Re:表の仕様のカプセル化
回答  neptune  - 07/7/24(火) 18:15 -

引用なし
パスワード
   ▼りった さん:
こんにちは


>1.先ずはRecordClassのコレクションを作って、その後好きに料理するってことですか?
はい。そういう事です。
UPしたソースでは書きませんでしたが、操作用クラスにAddメソッドや、
Itemsプロパティなどを用意してやると、もっと「らしく」なります。

keyをユニークなものにしておくと、keyで一発検索できるのも今回のような
データでは優位性がありますかね?

>2.下記の 2 , 3 は列番号ですか?
その通り!
>>       .ランク = pSh.Range(r, lcol + 2).Value
>>       .管理番号 = pSh.Range(r, lcol + 3).Value
>
大変申し訳ないです。なにしろ書いただけで走らせてないものでm(_ _)m
      .ランク = pSh.cells(r, lcol + 2).Value
      .管理番号 = pSh.cells(r, lcol + 3).Value
ですね。

>尚、アクセス使わない理由は、下記です。
そうなんですか。

百も承知とは思いますが、今後見るかもしれない方の為に書いておくと
配布において、Accessというアプリケーションと、mdbというDBファイルとは
また意味合いが違いますので、お間違いのないように。

AccessのないPCでもExcelからDAO,ADOを使用すればmdbの全操作はできます
から、この形もアリかなと思いました。

※Access固有の機能を使用する時は勿論、Accessアプリケーション又は
ランタイムが必要です。Access.exeそのものの配布は出来ません。

【50518】Re:表の仕様のカプセル化
お礼  りった  - 07/7/30(月) 17:24 -

引用なし
パスワード
   遅くなりましたが、回答ありがとうございます。教えて頂いた内容を元にプログラムを修正し、まずは満足いくレベルになりました。
プログラム載せようとしたのですが、長すぎて(?)エラーになるので断念しました。

5485 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free