[三流君] −−＞ [ＶＢＡで楽しく] −−＞ [バックナンバー一覧]
−−＞ No.106 Access サブフォームで連結 重複を弾いてメインに表示

Access サブフォームで連結 重複を弾いてメインに表示

メルマガ発行内容

＜Access サブフォームで連結 重複を弾いてメインに表示＞

どうも、三流プログラマーのＫｅｎ３です。

今回は、
読者よりもらった質問をまたまた、処理してみたいと思います。
※２週間以上前にもらった質問だった、、、
　なかなかいい処理が思いつかなくて。

じゃ、いい処理思いついたのかよ！といわれると、ドロドロした逃げ手なんだけど。

いつものように、たいした解説、回答内容じゃないので、
暇つぶしに休み時間などに拾い読みしてください。

サンプルファイルは、
http://www.ken3.org/vba/lzh/vba106.lzh
にdb106.mdb(Access2000版)が保存されています。


/*
 * １．今回のキッカケ
*/


メールで下記の質問をもらいました。
----
>例としまして（本当はもっとドロドロしたデータベースなんですが、
>　　　　　　　違う例えで書いてみました。）
>
>親フォームが音楽のバンド名が記載されてます。
>サブフォームには、
>そのバンドのメンバーと出身県と楽器と年齢などが記載されています。
>
>そこで、親フォームには、そのバンドのメンバーの出身県が出るテキスト
>ボックスがあります。
>
>例えば・・・バンド名（BOOWY）−−−−−−−−−−親フォーム
>　　　　　　メンバー（氷室、布袋、松井、高橋）−−サブフォーム
>  　　　　　出身県（群馬、群馬、群馬、福島）−−−サブフォーム
>
>●質問１
>
>で、このサブフォームに記載されている、出身県を親のフォームの
>任意に作成したテキストボックスの中に「群馬、福島」とだけ表示したいのです。
>
>「群馬、群馬、群馬、福島」と表示するのは、ちょっと・・・。
>群馬がだぶっているので、群馬の表示は１つとしたいのです。
>
>
>●質問２
>
>また、沢山のバンドや歌手をこのデータベースに入力します。
>そこで、「布袋」と検索すると、親フォームの「BOOWY」が表示されるようにしたい
>のです。
>
>まず親フォームのバンド名には
>「バンドID」と云う名のフィールド名の主キー（オートナンバー）がありまして
>
>それをサブフォームの中にもフィールド名で、 同じ「バンドID」という
>固有のデータで繋がっているです。
>
>こんな説明で分かってもらえるんでしょうか・・・。
>すごく不安です。
-----

２つの親子テーブルが存在して、
バンドIDでつなげた、フォーム・サブフォームが存在する。

まずは、
親フォームにある、
そのバンドのメンバーの出身県が出るテキストボックスに表示する。

これを処理してみたいと思います。


/*
 * ２．調べごと、下準備
*/


親テーブル名:T_バンド名
バンドID   オートナンバー
バンド名称 テキスト
備考       メモ型

子テーブル名：T_メンバー
個人ID     オートナンバー
バンドID   長整数型（親テーブルとリンクする）
名前       文字型
楽器       文字型
出身地     文字型
生年月日   日付型 *今回関係ないけど
備考       文字型 *今回関係ないけど

なんて、テーブル構成にして、フォームを作成しました。

ポイントは
^^^^^^^^^^^
普通に、子テーブルを表形式、親を単票で作成して、
親フォームのデザインで、サブフォーム・サブレポートのコントロールを選択します。


既存のフォーム（作成した子フォームを選択します）


リンクするフィールドを選択します
（名称が同じフィールドが自動で設定されると思います）


サブフォームの名前を決めて、終了です。

あとは、親フォームにtxt出身地と非連結のテキストボックスを作成します。
（※データセット、連結はこれから作ります）

さて、なんとか、ここまでは、簡単に作れました。


が、配置気にしない（笑）テスト用のイメージです


/*
 * ３．テーブルからデータを読み込んでみる
*/


ほしいのは、バンド別の出身地（重複無し）なのですが、
とっかかりは、
子テーブルをバンドIDを条件にして、
出身地を読み込みます。


Private Sub コマンド14_Click()
    
    Dim str出身地 As String '出身地の管理
    Dim rs As New ADODB.Recordset  'ADOのレコードセット
    
    Dim strSQL As String  'SQL文を作成するため
    
    'T_メンバーテーブルから出身地をバンドIDがフォームの値と一緒
    strSQL = "Select 出身地 From T_メンバー " _
           & " Where バンドID = " & Me![バンドID]
    
    'レコードセットを開く
    rs.Open strSQL, CurrentProject.Connection, _
                           adOpenKeyset, adLockOptimistic

    'ループ処理
    str出身地 = "" '空文字で初期化
    While rs.EOF = False  'いつものEOFが偽の間
        '出身地と" "スペース1つを＋する
        str出身地 = str出身地 & rs.Fields("出身地") & " "  
        rs.MoveNext  '次のレコードに移動しないと、とんでもないことに(笑)
    Wend

    rs.Close   '開いたら閉じろ、ドアを開けたら閉めるってしつけられたでしょ(笑)
    Set rs = Nothing  '変数も後始末しますか。使った器はキレイにしろって?

    'データのセットと確認メッセージ表示
    Me![txt出身地] = str出身地  '非連結のテキストボックスにデータセット
    MsgBox "作成した文字列は" & str出身地 & "です"

End Sub


ポイントは､
^^^^^^^^^^^^
T_メンバーテーブルから出身地をバンドIDがフォームの値と一緒
そんなデータがほしかったので、
Select 出身地 From T_メンバー 
 Where バンドID = 999

SQL文を作りたかったので、
" Where バンドID = " & Me![バンドID]
と、Me![バンドID]フォームの値を使用してます。

あとは、
.Open でレコードセットを開き､
ループの前に変数初期化、
.EOF でレコードセットの終わりを判断､
.Fields("出身地") で、出身地のフィールドにアクセス(値の参照)
str出身地 = str出身地 & rs.Fields("出身地") & " "
で、後ろに＋する。
.MoveNext で､次のレコードに進む

.Close で､レコードセットを閉じて､
Set rs = Nothing 変数もお行儀良く開放

作成結果を
Me![txt出身地] = str出身地  '非連結のテキストボックスにデータセット
で、
非連結のテキストボックスにデータセット
してます。

これで、
「群馬、群馬、群馬、福島」
まで、進みました。


↑テスト結果です。

えっ、進んだ？進んでナイジャン（笑）


/*
 * ４．重複をハジク方法
*/


重複をハジク方法、イロイロとあるのですが、
まずは、力技から。

群馬、群馬、群馬、福島
の場合、
初回は群馬をセット、
２回目の群馬は重複しているのでセットしない、
３回目の群馬もセットしない
４回目の福島はセットする。

文字列中から文字列を探す、
存在したら、データはセットしない、
存在しなかったら後ろに＋する

InStr関数を使用してみます。
^^^^^^^^^^^^^^^^^^^^^^^^^^^

Private Sub コマンド15_Click()
    Dim str出身地 As String '出身地の管理
    Dim n  As Integer  'サーチ文字列の発見場所
    Dim rs As New ADODB.Recordset  'ADOのレコードセット
    
    Dim strSQL As String  'SQL文を作成するため
    
    'T_メンバーテーブルから出身地をバンドIDがフォームの値と一緒
    strSQL = "Select 出身地 From T_メンバー " _
           & " Where バンドID = " & Me![バンドID]
    
    'レコードセットを開く
    rs.Open strSQL, CurrentProject.Connection, _
                           adOpenKeyset, adLockOptimistic

    'ループ処理
    str出身地 = "" '空文字で初期化
    While rs.EOF = False  'いつものEOFが偽の間
        'バッファの中に同じ出身地があるか場所をチェックする
        n = InStr(str出身地, rs.Fields("出身地"))
        If n = 0 Then  '出身地が見つからなかったら（重複してない時）
            '出身地と" "スペース1つを＋する
            str出身地 = str出身地 & rs.Fields("出身地") & " "
        End If
        rs.MoveNext  '次のレコードに移動しないと、とんでもないことに(笑)
    Wend

    rs.Close   '開いたら閉じろ、ドアを開けたら閉めるってしつけられたでしょ(笑)
    Set rs = Nothing  '変数も後始末しますか。使った器はキレイにしろって?

    'データのセットと確認メッセージ表示
    Me![txt出身地] = str出身地  '非連結のテキストボックスにデータセット
    MsgBox "作成した文字列は" & str出身地 & "です"

End Sub


ポイントは、
^^^^^^^^^^^^
    'ループ処理
    str出身地 = "" '空文字で初期化
まずは、バッファを空にする。
    While rs.EOF = False  'いつものEOFが偽の間
        'バッファの中に同じ出身地があるか場所をチェックする
        n = InStr(str出身地, rs.Fields("出身地"))
作成している出身地の変数内に、読み込んだ出身地があるかチェックする。
InStrで見つからない場合、０が返ります、これを判断し、
        If n = 0 Then  '出身地が見つからなかったら（重複してない時）
            '出身地と" "スペース1つを＋する
            str出身地 = str出身地 & rs.Fields("出身地") & " "
        End If
出身地が見つからなかった場合のみ、出身地を＋してます。

        rs.MoveNext  '次のレコードに移動しないと、とんでもないことに(笑)
    Wend


↑テスト結果です。

さてと、完成したし、いっかな。
なんて工夫がないと、
ヤッパ三流プログラマーってＳＱＬ文知らないんだぁ・・・
と、一言メッセージをモラッテシマウノデ、ＳＱＬ文で重複をハジク。

Group Byでグループ化するんダロ？簡単ジャンと思った読者の声を聞きつつ、
ギクっ読まれてるよ行動が。
ホカナイカナァ・・・

DISTINCTキーワード知らないんだぁ？
なにそのキーワード？
騙されたと思って、
Select DISTINCT 〜で、SQL文作ってみなよ

InStrを使う前のプログラムにDISTINCTキーワードを追加してみます。
    'T_メンバーテーブルから出身地をバンドIDがフォームの値と一緒
    strSQL = "Select DISTINCT 出身地 From T_メンバー " _
           & " Where バンドID = " & Me![バンドID]
と、Selectの後にキーワードを＋してみます。


Private Sub コマンド14_Click()
    
    Dim str出身地 As String '出身地の管理
    Dim rs As New ADODB.Recordset  'ADOのレコードセット
    
    Dim strSQL As String  'SQL文を作成するため
    
    'T_メンバーテーブルから出身地をバンドIDがフォームの値と一緒
    strSQL = "Select DISTINCT 出身地 From T_メンバー " _
           & " Where バンドID = " & Me![バンドID]
    
    'レコードセットを開く
    rs.Open strSQL, CurrentProject.Connection, _
                           adOpenKeyset, adLockOptimistic

    'ループ処理
    str出身地 = "" '空文字で初期化
    While rs.EOF = False  'いつものEOFが偽の間
        '出身地と" "スペース1つを＋する
        str出身地 = str出身地 & rs.Fields("出身地") & " "
        rs.MoveNext  '次のレコードに移動しないと、とんでもないことに(笑)
    Wend

    rs.Close   '開いたら閉じろ、ドアを開けたら閉めるってしつけられたでしょ(笑)
    Set rs = Nothing  '変数も後始末しますか。使った器はキレイにしろって?

    'データのセットと確認メッセージ表示
    Me![txt出身地] = str出身地  '非連結のテキストボックスにデータセット
    MsgBox "作成した文字列は" & str出身地 & "です"

End Sub


テストすると、オッ、できましたね。
SQLの結果で重複をハジクタメだけにグループ化してたけど、
物によっては、
Select DISTINCT
と、重複結果を取り除くキーワードを使ってみるのも面白そうですね。

手前味噌解説に酔ってないで、今、ボタンクリックしないと、
txt出身地にデータセットされないよ。
普通はグループが変わったタイミングで出身地も自動で変えたいよ。

そうでした。どちらの処理でもいいので、
グループが変わったタイミング、
親のフォームのレコード移動時に出身地の取得モジュールを書き込みます。

よし、動作したよと安心したら、
新規のデータを入力しようと、レコードを移動したら、
あらら、エラーだよ。

↑エラーメッセージ
    strSQL = "Select DISTINCT 出身地 From T_メンバー " _
           & " Where バンドID = " & Me![バンドID]
と、Me![バンドID]を参照しようとするが、
新規のデータなので、番号が無かったみたいです。

チェックを入れないとダメなのかぁ。
なんか、無いかなぁ・・新規レコードを判断するプロパティ。
探すと、そのまんまの、.NewRecordってプロパティがあった（笑）
    '新規のデータ時、下の処理を走らせない
    If Me.NewRecord = True Then  '.NewRecordで新規かチッェクする
        Me![txt出身地] = ""  '空文字でクリア
        Exit Sub  '関数を途中で抜ける
    End If
とチェックを入れて、新規データ追加時は、
出身地のデータはチェックしないことにしました。

下記、作成したレコード移動時のイベントです。


Private Sub Form_Current()
    Dim str出身地 As String '出身地の管理
    Dim rs As New ADODB.Recordset  'ADOのレコードセット
    
    Dim strSQL As String  'SQL文を作成するため
    
    '新規のデータ時、下の処理を走らせない
    If Me.NewRecord = True Then  '.NewRecordで新規かチッェクする
        Me![txt出身地] = ""  '空文字でクリア
        Exit Sub  '関数を途中で抜ける
    End If

    'T_メンバーテーブルから出身地をバンドIDがフォームの値と一緒
    'DISTINCTキーワードで重複をハジク
    strSQL = "Select DISTINCT 出身地 From T_メンバー " _
           & " Where バンドID = " & Me![バンドID]
    
    'レコードセットを開く
    rs.Open strSQL, CurrentProject.Connection, _
                           adOpenKeyset, adLockOptimistic

    'ループ処理
    str出身地 = "" '空文字で初期化
    While rs.EOF = False  'いつものEOFが偽の間
        '出身地と" "スペース1つを＋する
        str出身地 = str出身地 & rs.Fields("出身地") & " "
        rs.MoveNext  '次のレコードに移動しないと、とんでもないことに(笑)
    Wend

    rs.Close   '開いたら閉じろ、ドアを開けたら閉めるってしつけられたでしょ(笑)
    Set rs = Nothing  '変数も後始末しますか。使った器はキレイにしろって?

    'データのセット
    Me![txt出身地] = str出身地  '非連結のテキストボックスにデータセット

End Sub



/*
 * ５．終わりの挨拶
*/


サンプルファイルは、
http://www.ken3.org/vba/lzh/vba106.lzh
にdb106.mdb(Access2000版)が保存されています。
動作を見るのが一番早いかも。

今回は、
テーブルから重複値をハジク方法で、
InStrで探して追加しない方法
と
Select DISTINCT キーワードを使用して、
SQL文で重複結果を返さない方法の２つをテストしてみました。

あと、おまけで、レコード移動時に新規レコードか？判断するときは
.NewRecordプロパティを参照しました。

何かの参考となれば幸いです。

Ｅｘｃｅｌ／Ａｃｃｅｓｓ大好き、三流プログラマーＫｅｎ３でした。

フィードバック

VBA系の→[掲示板]←を覗く、質問を書き込む

評価・感想

No.106を読んだ満足度(評価)は？
5満足（参考になった）
4まぁまぁ（一部参考になった）
3普通（どちらとも言えない）
2なんかなぁ（期待と違った）
1不満（読んで損した気分）
 作者に感想・質問を送る場合は下記に気軽に書いてください
あなたのお名前（ニックネーム） さん

作者からの返信は、 不用 E-mail で受信したい
＊質問・感想はメルマガで紹介する場合があります

ページフッター(リンクや広告など)

[三流君(TOP ken3.org へ戻る)]
-- [VBA系TOPへ]
---- [VBA系バックナンバー目次へ移動]
------ [VBAでIEを操作 CreateObject("InternetExplorer.application")]・・・実は当店一番人気、VBAでIEを操作するサンプルです
------ [VBAでOutlookの操作 CreateObject("Outlook.Application")]・・・Outlookを使い、メール関係の処理です
------ [Access から Excel 連携 CreateObject("Excel.Application")]・・・人気のAccessからExcelへデータ書き出しなどです
------ [AccessのUserForm/サブフォームを操作]・・・アクセスでフォームを使ったサンプルです
------ [Accessのレポートを操作]・・・レポートを操作してみました
------ [Access クエリー関係やその他関数]・・・あまりまとまってませんが、スポット的な単体関数の解説です
------ [Excel UserForm(ユーザーフォーム)を操作する]・・・エクセルでユーザーフォームを作成して入力などを行ってます
------ [ExcelからAccessを操作する]・・・ExcelからAccessのマクロを起動してみました、
------ [Excel関係 関数、その他]・・・その他Excel関係です
------ [VBAでテキストファイル(*.txt,*.html,*.csv)の操作]・・・テキストファイルを使ったサンプルです
------ [VBA 標準関数関係とその他解説]・・・その他、グダグタ解説してます
広告
-- [通販系の売れ筋広告へ] ←主に楽天やAmazonのランキングです
blog
-- [三流君の作業日記] ← 日々の作業を少々
-- [通販あしあと] ← 通販ページの足跡を一覧で羅列

情報を探す

情報を探すならGoogleかな？

↓Web全体、サポート情報(support.microsoft.com)や三流君VBA(ken3.org)から検索する
Google
Web www.ken3.org
www.microsoft.com support.microsoft.com
あとは、項目別にMSでお勉強かな？
◆ マイクロソフト サイトの歩き方
◇ How-To インデックス
◇ FAQ インデックス
◇ スキルレベル別おすすめコンテンツ
◇ テクノロジ マップ
◇ テーマ別技術資料一覧

書籍の購入

Webだけじゃさすがに勉強しきれないので、プログラミング関係の書籍も読んでみては？？

コンピュータ書籍の発送がハヤイ専門店

コンピュータの本・専門店
 ※種類が豊富で探し易いです。※在庫ありが48時間以内発送が急ぎで資料や書籍がほしい時、とても助かります。
お奨め本の目次を見るだけでも勉強になったり

amazon.co.jpでキーワード別チェック

下記、私が設定したキーワードですが、こんな感じで資料や書籍を探ってみては？
[VBA全体を把握する] -- やはり全体をさらっと見たいですよね。
[SQL関連でＤＢ力UP] -- システムはデータベース設計が重要
[ADO接続を探る] -- VBAなのでADO接続を押さえておく
[Windows APIを探る] -- さらにAPIになて知ってれば強力だ！
[.NETを探る] -- と言っても時代は.NETに流れてるし
プログラミング以外でも知りたいことは多くって、
[人間関係] -- で、客先・上司、まわりに気を使い。
[プログラマーの自己啓発] -- プログラムだけじゃなくいろいろと向上したいよ
[コーチング・育成] -- 先輩になったら後輩(部下)の面倒をみてね。
そんなこんなでプログラマーっていろいろと大変なんだってば・・・