Excel VBA質問箱 IV

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

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


47164 / 76732 ←次へ | 前へ→

【34530】Re:構造体の配列を検索する。
発言  ichinose  - 06/2/5(日) 12:01 -

引用なし
パスワード
   皆さん、こんにちは。訂正があったので再送です。

>この中にいろんなIDの情報があるとしますが、
>そのなかに同じ番号のIDも入っているとします。
>そこで
>同じIDの情報だけを検索して取り出すにはどのようにしたらいいのでしょうか?
>できたら早く動くようなコードでお願いしたいです。
>よろしくお願いします。

>単純な配列なので特に速い方法はないと思います。
>ループさせて見つけるだけでしょう。
とinoue さんもおっしゃっているように
データ数が多くなければ
逐次検索でもそんなに遅いと感じないと思いますが・・。
BlueさんがおっしゃっているScripting.Dictionaryを使ってみました。
(もっとも私は、普段はCollectionを良く使いますが)。

ユーザー定義型でなければもう少し簡単なのですが、
あえてインターフェースにご指定のユーザー定義型を
使いました(ユーザー定義型にしたのも何か理由があるのでしょうから)。

まず、クラスモジュール(クラス名は 既定のClass1)に

'===========================================================
Option Explicit
Private udsv() As EmployeeRecord
Private udcnt As Long '登録配列数
'===========================================================
Function get_ud(ud As EmployeeRecord, Optional ByVal first As Boolean = False) As Long
  Static uidx As Long
  If first = True Then
    uidx = 1
    End If
  get_ud = 0
  If uidx <= udcnt Then
    With ud
     .ID = udsv(uidx).ID
     .Name = udsv(uidx).Name
     .Address = udsv(uidx).Address
     .Phone = udsv(uidx).Phone
     .HireDate = udsv(uidx).HireDate
     End With
    uidx = uidx + 1
  Else
    get_ud = 1
    End If
End Function
'===========================================================
Sub put_ud(ud As EmployeeRecord)
  ReDim Preserve udsv(1 To udcnt + 1)
  With udsv(udcnt + 1)
    .ID = ud.ID
    .Name = ud.Name
    .Address = ud.Address
    .Phone = ud.Phone
    .HireDate = ud.HireDate
   End With
  udcnt = udcnt + 1
End Sub
'===========================================================
Private Sub Class_Initialize()
  udcnt = 0
End Sub
'===========================================================
Private Sub Class_Terminate()
  On Error Resume Next
  Erase udsv()
End Sub


次に標準モジュールに
'===========================================================
Private dic As object
Type EmployeeRecord
  ID As Integer
  Name As String
  Address As String
  Phone As Long
  HireDate As Date
End Type
'===========================================================
Sub open_dic()
'Dictionary オブジェクトのインスタンスを生成し、ユーザー定義型データのデータベースを初期化する
  Set dic = CreateObject("Scripting.Dictionary")
End Sub
'===========================================================
Sub close_dic()
'Dictionary オブジェクトの終了
  Set dic = Nothing
End Sub
'===========================================================
Function put_dic(ud As EmployeeRecord) As Long
'ユーザー定義型変数EmployeeRecordを登録する
' input : ud--登録するユーザー定義型データ(キーはIDとする)
' output: put_dic:今のところ0が返る
  Dim cls1 As Class1
  Dim acnt As Long
  put_dic = 0
  With dic
    If .Exists(ud.ID) = False Then
     Set cls1 = New Class1
     cls1.put_ud ud
     .Add ud.ID, cls1
    Else
     Set cls1 = .Item(ud.ID)
     cls1.put_ud ud
     
     End If
    End With
End Function
'===========================================================
Function get_dic(ud As EmployeeRecord, Optional ID As Variant = "") As Long
'登録されたユーザー定義型データの中から、指定されたIDのデータを取得する
'Input:ID----取得するユーザー定義型のID(省略すると、前回指定されたIDで取得する)
'output:ud---取得するユーザー定義型データ
'    get_dic---0---正常終了  ---1---データの終わり
  Static svid As Variant
  Static cls1 As Class1
  get_dic = 0
  Dim cls As Class1
  With dic
   If ID <> "" Then
     If .Exists(ID) = False Then
      get_dic = 1
     Else
      Set cls1 = .Item(ID)
      With cls1
       get_dic = .get_ud(ud, True)
       End With
      End If
   Else
     With cls1
      get_dic = .get_ud(ud)
      End With
     End If
   End With
End Function


最後に別の標準モジュールに
'===========================================================

Option Explicit

Sub main()
  Dim 顧客情報 As EmployeeRecord
  Dim ans As Variant
  Dim ret As Long
  Call open_dic
'**********************************************************************************************
'サンプル作成
  
  With 顧客情報
   .ID = 1
   .Name = "aaa"
   .Address = "あああああ"
   .Phone = 323231111
   .HireDate = Date
   End With
  Call put_dic(顧客情報)
  With 顧客情報
   .ID = 1
   .Name = "bbb"
   .Address = "いいいいいい"
   .Phone = 311112222
   .HireDate = Date + 1
   End With
  Call put_dic(顧客情報)
  With 顧客情報
   .ID = 1
   .Name = "ccc"
   .Address = "うううううう"
   .Phone = 333334444
   .HireDate = Date + 2
   End With
  Call put_dic(顧客情報)
  With 顧客情報
   .ID = 2
   .Name = "ddd"
   .Address = "えええええええ"
   .Phone = 355556666
   .HireDate = Date + 3
   End With
  Call put_dic(顧客情報)
  With 顧客情報
   .ID = 3
   .Name = "eee"
   .Address = "おおおおおおおおお"
   .Phone = 377778888
   .HireDate = Date + 4
   End With
  Call put_dic(顧客情報)
  With 顧客情報
   .ID = 2
   .Name = "fff"
   .Address = "かかかかかかかか"
   .Phone = 399990000
   .HireDate = Date + 5
   End With
  Call put_dic(顧客情報)
  MsgBox "サンプルデータの作成"
'*************************************************************************************
'


  MsgBox "ID=1のデータの取得"
  
  ret = get_dic(顧客情報, 1)
  Do While ret = 0
    With 顧客情報
     MsgBox .ID & vbCrLf & .Name & vbCrLf & .Address & vbCrLf & .Phone & vbCrLf & .HireDate
     End With
    ret = get_dic(顧客情報)
    Loop
'************************************************************************************
  MsgBox "ID=2のデータの取得"
  
  
  ret = get_dic(顧客情報, 2)
  Do While ret = 0
    With 顧客情報
     MsgBox .ID & vbCrLf & .Name & vbCrLf & .Address & vbCrLf & .Phone & vbCrLf & .HireDate
     End With
    ret = get_dic(顧客情報)
    Loop
'************************************************************************************
  MsgBox "ID=3のデータの取得"
  ret = get_dic(顧客情報, 3)
  Do While ret = 0
    With 顧客情報
     MsgBox .ID & vbCrLf & .Name & vbCrLf & .Address & vbCrLf & .Phone & vbCrLf & .HireDate
     End With
    ret = get_dic(顧客情報)
    Loop
  Call close_dic
End Sub


これでmainを実行してみて下さい。
0 hits

【34519】構造体の配列を検索する。 よっちん 06/2/4(土) 22:00 質問
【34522】Re:構造体の配列を検索する。 inoue 06/2/5(日) 1:14 発言
【34523】Re:構造体の配列を検索する。 Blue 06/2/5(日) 3:16 発言
【34524】Re:構造体の配列を検索する。 よっちん 06/2/5(日) 4:02 質問
【34530】Re:構造体の配列を検索する。 ichinose 06/2/5(日) 12:01 発言
【34576】Re:構造体の配列を検索する。 よっちん 06/2/7(火) 7:59 お礼

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