★★★★★★Excel2000VBA独学～★★★★★★　『 SQL の学習用』の続き ★★★★★★～「パラメータクエリ」を使って、ドロップダウンを段階的に絞り込む実験～

★★★★★★Excel2000VBA独学～★★★★★★　『 SQL の学習用』の続き ★★★★★★～「パラメータクエリ」を使って、ドロップダウンを段階的に絞り込む実験～
　　
※まだ書きかけです。すみません。
※間違ってたらすみません。
※メモ書きなので、自分でも意味不明な箇所も多いです。ごめんなさい。

ファイル名やフルパスが変わると正常動作しなくなるようなのでやったらダメ。
それでもあえてやりたい場合は、以下の通り。

https://euc-access-excel-db.com/tips/ct07_se/ct075012_xls2k_vba_tips/odbc-miquery-make01
のサンプルを使います。

サンプルのダウンロード

このサンプルの、Sheet1に以下のようなリスト表を作った場合です。
（以下をテキストファイルにコピペ後、スペースをTABに置換してExcelのA1セルの位置にコピペします。）

大分類中分類小分類小々分類
A a あイ
A a あロ
A a いハ
A b うニ
A b えホ
A b えヘ
B c おト
B c おチ
B c かリ
B d きヌ
B d くル
B d くヲ
C e けワ
C e けカ
C e こヨ
C f さタ
C f さレ
C f しソ
A g ほにゃ
A g ほにゅ
A g ほにゅ
A g ほひょ
A g hi ma
A g hi ru
A g hi mo
A g hi nn

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

Sheet2モジュールに以下のコードをコピペ

'
'

Sub test02()
        
    Dim s_TrgFNm001jj       As String      '外部の、吸い込みたい先のファイル
    Dim s_TrgFoldPath001jj  As String      'そのファイルが在るフォルダ
    Dim s_SqlStr01jj        As String      '吸い込むときのSQL内容
    Dim s_ChkQTobjNm01jj    As String      '付けたい、「QueryTableオブジェクトの名前」
    Dim o_ImpSht001jj       As Worksheet   'このファイルの中の、QTオブジェクトを生成したいシート（オブジェクト）
    Dim s_ImpCelAddr001jj   As String      'そのシートのQTオブジェクトを生成したいセル位置


    '★設定部
    
    '他ファイルデータの吸込み用設定
    s_TrgFNm001jj = "D:\1\test98.xlsm"                '外部の、吸い込みたい先のファイル
    s_TrgFoldPath001jj = "D:\1"                 'そのファイルが在るフォルダ
    Set o_ImpSht001jj = Worksheets("Sheet2")    'このファイルの中の、QTオブジェクトを生成したいシート（オブジェクト）
    s_ImpCelAddr001jj = "$A$1"                  'そのシートのQTオブジェクトを生成したいセル位置


'    '自ファイルデータの吸込み用設定
'    s_TrgFNm001jj = ThisWorkbook.FullName         '外部の、吸い込みたい先のファイル
'    s_TrgFoldPath001jj = ThisWorkbook.Path        'そのファイルが在るフォルダ
'    Set o_ImpSht001jj = Worksheets("Sheet2")      'このファイルの中の、QTオブジェクトを生成したいシート（オブジェクト）
'    s_ImpCelAddr001jj = "$A$1"                    'そのシートのQTオブジェクトを生成したいセル位置
        
    o_ImpSht001jj.Activate
    o_ImpSht001jj.Range("A1").Select
    
        
    s_ChkQTobjNm01jj = "QTSht02"
       '「重複を調べたい＝付けたい」
       '「QueryTableオブジェクトの名前」の設定
        
    
    'SQL文の設定
    s_SqlStr01jj = "SELECT * FROM `Sheet1$`"
 
        '※テーブル名は上記のように「`」で囲むのもOKですし、
        '  「角カッコ」で囲むのもOKです。
        '   角カッコで囲むと『 [Sheet1$] 』となります。
        '   フィールド名に別名を付けたときは、別名に角カッコを使うほうが
        '   結果の表のフィールド名に「’」が付かないので便利かもしれません。
    

    
    
    '★ チェック部
    
    '指定したブック内に、指定した名前を含むQueryTableオブジェクトが
    '既に存在していないかどうかをチェック。
    '在ったら中断。
    If QTSonzaiChk01(ThisWorkbook, s_ChkQTobjNm01jj) = 1 Then
        Exit Sub
    Else
    
    End If
    
 
 
 
    '★ 実動部
    
    'SQLの実行＝SQLでの吸込み
    Call MSQryOnlMakeByODBCFunc001(s_TrgFNm001jj, _
                                   s_TrgFoldPath001jj, _
                                   s_SqlStr01jj, _
                                   s_ChkQTobjNm01jj, _
                                   o_ImpSht001jj, _
                                   s_ImpCelAddr001jj)
 
' 呼び出し方法
'    Call MSQryOnlMakeByODBCFunc001("読みに行きたいファイルのフルパス",
'                                   "そのファイルの在るフォルダのパス",
'                                   SQL文,
'                                   結果表（QueryTableオブジェクト）につけたい名前,
'                                   結果を出力したい「オブジェクトとしての」シート.
'                                   結果表を出力するセルのアドレス（表の一番左上隅のセルの。)
'


End Sub

'
'

Sub test02()

Dim s_TrgFNm001jj As String '外部の、吸い込みたい先のファイル

Dim s_TrgFoldPath001jj As String 'そのファイルが在るフォルダ

Dim s_SqlStr01jj As String '吸い込むときのSQL内容

Dim s_ChkQTobjNm01jj As String '付けたい、「QueryTableオブジェクトの名前」

Dim o_ImpSht001jj As Worksheet 'このファイルの中の、QTオブジェクトを生成したいシート（オブジェクト）

Dim s_ImpCelAddr001jj As String 'そのシートのQTオブジェクトを生成したいセル位置

'★設定部

'他ファイルデータの吸込み用設定

s_TrgFNm001jj = "D:\1\test98.xlsm" '外部の、吸い込みたい先のファイル

s_TrgFoldPath001jj = "D:\1" 'そのファイルが在るフォルダ

Set o_ImpSht001jj = Worksheets("Sheet2") 'このファイルの中の、QTオブジェクトを生成したいシート（オブジェクト）

s_ImpCelAddr001jj = "$A$1" 'そのシートのQTオブジェクトを生成したいセル位置

' '自ファイルデータの吸込み用設定

' s_TrgFNm001jj = ThisWorkbook.FullName '外部の、吸い込みたい先のファイル

' s_TrgFoldPath001jj = ThisWorkbook.Path 'そのファイルが在るフォルダ

' Set o_ImpSht001jj = Worksheets("Sheet2") 'このファイルの中の、QTオブジェクトを生成したいシート（オブジェクト）

' s_ImpCelAddr001jj = "$A$1" 'そのシートのQTオブジェクトを生成したいセル位置

o_ImpSht001jj.Activate

o_ImpSht001jj.Range("A1").Select

s_ChkQTobjNm01jj = "QTSht02"

'「重複を調べたい＝付けたい」

'「QueryTableオブジェクトの名前」の設定

'SQL文の設定

s_SqlStr01jj = "SELECT * FROM `Sheet1$`"

'※テーブル名は上記のように「`」で囲むのもOKですし、

' 「角カッコ」で囲むのもOKです。

' 角カッコで囲むと『 [Sheet1$] 』となります。

' フィールド名に別名を付けたときは、別名に角カッコを使うほうが

' 結果の表のフィールド名に「’」が付かないので便利かもしれません。

'★ チェック部

'指定したブック内に、指定した名前を含むQueryTableオブジェクトが

'既に存在していないかどうかをチェック。

'在ったら中断。

If QTSonzaiChk01(ThisWorkbook, s_ChkQTobjNm01jj) = 1 Then

Exit Sub

Else

End If

'★ 実動部

'SQLの実行＝SQLでの吸込み

Call MSQryOnlMakeByODBCFunc001(s_TrgFNm001jj, _

s_TrgFoldPath001jj, _

s_SqlStr01jj, _

s_ChkQTobjNm01jj, _

o_ImpSht001jj, _

s_ImpCelAddr001jj)

' 呼び出し方法

' Call MSQryOnlMakeByODBCFunc001("読みに行きたいファイルのフルパス",

' "そのファイルの在るフォルダのパス",

' SQL文,

' 結果表（QueryTableオブジェクト）につけたい名前,

' 結果を出力したい「オブジェクトとしての」シート.

' 結果表を出力するセルのアドレス（表の一番左上隅のセルの。)

End Sub

============================================================

●「シート上の既存の複数のQyeryTableオブジェクト」を「削除しない」ためのコードの書き換え

MSQryOnlMakeByODBCFunc001()の、
「シート上の既存のQyeryTableオブジェクトを削除する部分のブロック」をコメントアウトする。
以下の部分。

'すでにあるQueryTableオブジェクトを処理する
If 1 <= o_ImpWSht01jj.QueryTables.Count Then o_ImpWSht01jj.QueryTables(1).Delete ' o_ImpWSht01jj.Cells.ClearContents o_ImpWSht01jj.Rows.Delete 'いったんQueryTableオブジェクトを削除。 '紐ついている名前定義も一緒に消去されます。 Else End If Sheet2モジュールの場合は、test02()を以下のように書き変える。別の少し右側に新しいQueryTableオブジェクトを生成するために。吸い込みシートを「自ファイル」の「目的のシート」に設定。 '他ファイルデータの吸込み用設定 s_TrgFNm001jj = "D:\1\test98.xlsm" '外部の、吸い込みたい先のファイル s_TrgFoldPath001jj = "D:\1" 'そのファイルが在るフォルダ Set o_ImpSht001jj = Worksheets("Sheet×××") 'このファイルの中の、QTオブジェクトを生成したいシート（オブジェクト） s_ImpCelAddr001jj = "$A$1" 'そのシートのQTオブジェクトを生成したいセル位置を '他ファイルデータの吸込み用設定 s_TrgFNm001jj = "D:\1\自ファイル名.xlsm" '外部の、吸い込みたい先のファイル s_TrgFoldPath001jj = "D:\1" 'そのファイルが在るフォルダ Set o_ImpSht001jj = Worksheets("Sheet×××") 'このファイルの中の、QTオブジェクトを生成したいシート（オブジェクト） s_ImpCelAddr001jj = "$×××$1" 'そのシートのQTオブジェクトを生成したいセル位置に。「o_ImpSht001jj.Range("A1").Select」を「o_ImpSht001jj.Range(s_ImpCelAddr001jj).Select」に書き変え。「s_SqlStr01jj = "SELECT * FROM Sheet1$"」を
「s_SqlStr01jj = "SELECT * FROM [Sheet2$xxxxxxx]"」に書き変え

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

Webから「CangeQramQueryOnePrm01()」をコピペ。
https://euc-access-excel-db.com/tips/ct07_se/ct075012_xls2k_vba_tips/odbc-miquery-make01#lbl_1311
のコード。

「パラメータのデータ型」の「xlParamTypeChar」はそのまま。数値型などのほかのデータ型に変えたかったら、
Parameters.Addメソッドのヘルプの、「XlParameterDataType 列挙」のリンクに書いてあります。

'
'

Sub CangeQramQueryOnePrm01()
 
    Dim qt              As QueryTable
    Dim s_SQLStr01      As String
    
    Dim Param1          As Parameter
    Dim o_ParamRange1   As Range
    Dim s_PrmNm1        As String
    
On Error GoTo error1:
 
    '★ 設定部
    
    Set qt = Worksheets("sheet1").QueryTables(1)            '既存の「最新の（最後に作った）」QueryTableオブジェクトの選定（＝取得）
    s_SQLStr01 = qt.Sql                                     'SQL文をコメントアウトしたときのための、初期値としてのSQL文の設定
    
    'パラメータの設定は、★実動部で全部一度にやる。
    'データ型の指定やセル位置など、そこそこ設定する項目が多いため
    'プログラムの中で上下に分かれると設定が面倒なため。

    '★★★★↑複数のQueryTableオブジェクトを作成する場合、★★★★
    '★★★★　QueryTables(1)」が最新のQueryTableオブジェクトになるっぽい。★★★★

 
   
    '★ 先にチェック部
    'もし、すでにパラメータの設定があったら
    'いったんそれを削除する。
    
    If 1 <= qt.Parameters.Count Then
        qt.Parameters.Delete  'すべてのパラメータをいったん削除
    Else
        
    End If
        
    'SQLの設定。    'ここをコメントアウトすると、セルの位置だけの変更ができます。
    
''    '完全一致の場合のSQLの例
'    s_SQLStr01 = "SELECT * FROM `Sheet1$` WHERE (具 = ?)"
    
'    '部分一致の条件のSQLの例
'    s_SQLStr01 = "SELECT * FROM `Sheet1$` WHERE (具 Like ?)"
 
 
    s_SQLStr01 = ""
    s_SQLStr01 = s_SQLStr01 & "SELECT"
    s_SQLStr01 = s_SQLStr01 & "         *"
    s_SQLStr01 = s_SQLStr01 & " FROM"
    s_SQLStr01 = s_SQLStr01 & "         [Sheet1$]"
    s_SQLStr01 = s_SQLStr01 & " WHERE"
    s_SQLStr01 = s_SQLStr01 & "        (具 Like ?)"
                                          '↑「Like」を使った場合は、セル側で「%語句%」と「%」で囲んだり、
                                          '  「%」を末尾につけたりして、絞り込みします。
                                          '   この場合、セル側で「%」だけを打つとすべてのデータが表示されます。
                                          '  「?」を３つ使ってますので、
                                          '   パラメータとしては３つ分の設定が要ります。
                                          '   先にSQLを書いてから、パラメータ用の変数と
                                          '   パラメータオブジェクトの設定を増やしたり減らしたり
                                          '   すればいいと思います。
 
    '★ 実動部
    
    '新しいSQL文に変更。
    'パラメータクエリの場合は、
    '基本的には、パラメータの設定よりも先に、
    'SQL文をセットしないといけないっぽいです。
    'SQL文の中の「?」がパラメータに相当するので
    'それを先に作っておかないと、パラメータの
    '設定がそもそもできないのかも？
    'よくわかりません。
 
    qt.Sql = s_SQLStr01                                           '既存のQTオブジェクトに新しいSQL文のセット。
    
    
 
    '１つめのパラメータの設定
    
    s_PrmNm1 = "具Prm"                                        'パラメータクエリのパラメータ自体につける名前（パラメータ＝Parameterはオブジェクトなので）
    Set Param1 = qt.Parameters.Add(s_PrmNm1, xlParamTypeChar)     '１つめの新しいパラメータを「日付型」として作成。（SQLの「?」の内容の変更に伴い、XlParameterDataType 列挙のデータ型を指定。）
    Set o_ParamRange1 = Worksheets("sheet1").Range("G2")          'パラメータの値を入力したいセルの選定（＝取得）
    Param1.SetParam xlRange, o_ParamRange1                        'シートのセルを条件値の入力場所に設定。
    Param1.RefreshOnChange = True                                 'セルの値を変更と同時に自動更新（自動反映）する設定。
    
    o_ParamRange1.Interior.Color = vbYellow                       'そのセルを黄色にする
    o_ParamRange1.Offset(0, 1).Value = "具Prm"
    o_ParamRange1.Value = "%"    'ダミーデータの入力。パラメータセルが空白なことでエラーになることの回避
       
    qt.AdjustColumnWidth = False  '列幅の自動調整をOFFに。
    qt.Refresh                                                    '新しいSQLの内容通りに、更新の実行。
 
Exit Sub
 
error1:
 
    If Err.Number = 1004 Then
        MsgBox "一応エラーになりましたが、" & vbCrLf & _
               "SQL文は正しくて、「単にパラメータのセルに値が入っていないだけ」、かもしれません｡ " & vbCrLf & _
               "" & vbCrLf & _
               "このまま続行しますので、パラメータの値を全部入れてみてください。" & vbCrLf & _
               "" & vbCrLf & _
               "       ※最初のパラメータを入れてエラーになってもそれは正常です。" & vbCrLf & _
               "        　そのまますべてのパラメータを入力し続けてください。" & vbCrLf & _
               "        　(空白セルが残っているためにエラーになっているだけですので。）" & vbCrLf & _
               "" & vbCrLf & _
               "        　ただ、日付やワイルドカート(%など）は必ず半角で入力してください。" & vbCrLf & _
               "" & vbCrLf & _
               "もし全てのパラメータを入力していも表が変化しなかったら、" & vbCrLf & _
               "まずSQL文を、次に、各種設定を見直してみてください。"
               
        Resume Next
    Else
    
    
    End If
 
 
 
End Sub

'
'

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

Sub CangeQramQueryOnePrm01()

Dim qt As QueryTable

Dim s_SQLStr01 As String

Dim Param1 As Parameter

Dim o_ParamRange1 As Range

Dim s_PrmNm1 As String

On Error GoTo error1:

'★ 設定部

Set qt = Worksheets("sheet1").QueryTables(1) '既存の「最新の（最後に作った）」QueryTableオブジェクトの選定（＝取得）

s_SQLStr01 = qt.Sql 'SQL文をコメントアウトしたときのための、初期値としてのSQL文の設定

'パラメータの設定は、★実動部で全部一度にやる。

'データ型の指定やセル位置など、そこそこ設定する項目が多いため

'プログラムの中で上下に分かれると設定が面倒なため。

'★★★★↑複数のQueryTableオブジェクトを作成する場合、★★★★

'★★★★　QueryTables(1)」が最新のQueryTableオブジェクトになるっぽい。★★★★

'★ 先にチェック部

'もし、すでにパラメータの設定があったら

'いったんそれを削除する。

If 1 <= qt.Parameters.Count Then

qt.Parameters.Delete 'すべてのパラメータをいったん削除

Else

End If

'SQLの設定。 'ここをコメントアウトすると、セルの位置だけの変更ができます。

'' '完全一致の場合のSQLの例

' s_SQLStr01 = "SELECT * FROM `Sheet1$` WHERE (具 = ?)"

' '部分一致の条件のSQLの例

' s_SQLStr01 = "SELECT * FROM `Sheet1$` WHERE (具 Like ?)"

s_SQLStr01 = ""

s_SQLStr01 = s_SQLStr01 & "SELECT"

s_SQLStr01 = s_SQLStr01 & " *"

s_SQLStr01 = s_SQLStr01 & " FROM"

s_SQLStr01 = s_SQLStr01 & " [Sheet1$]"

s_SQLStr01 = s_SQLStr01 & " WHERE"

s_SQLStr01 = s_SQLStr01 & " (具 Like ?)"

'↑「Like」を使った場合は、セル側で「%語句%」と「%」で囲んだり、

' 「%」を末尾につけたりして、絞り込みします。

' この場合、セル側で「%」だけを打つとすべてのデータが表示されます。

' 「?」を３つ使ってますので、

' パラメータとしては３つ分の設定が要ります。

' 先にSQLを書いてから、パラメータ用の変数と

' パラメータオブジェクトの設定を増やしたり減らしたり

' すればいいと思います。

'★ 実動部

'新しいSQL文に変更。

'パラメータクエリの場合は、

'基本的には、パラメータの設定よりも先に、

'SQL文をセットしないといけないっぽいです。

'SQL文の中の「?」がパラメータに相当するので

'それを先に作っておかないと、パラメータの

'設定がそもそもできないのかも？

'よくわかりません。

qt.Sql = s_SQLStr01 '既存のQTオブジェクトに新しいSQL文のセット。

'１つめのパラメータの設定

s_PrmNm1 = "具Prm" 'パラメータクエリのパラメータ自体につける名前（パラメータ＝Parameterはオブジェクトなので）

Set Param1 = qt.Parameters.Add(s_PrmNm1, xlParamTypeChar) '１つめの新しいパラメータを「日付型」として作成。（SQLの「?」の内容の変更に伴い、XlParameterDataType 列挙のデータ型を指定。）

Set o_ParamRange1 = Worksheets("sheet1").Range("G2") 'パラメータの値を入力したいセルの選定（＝取得）

Param1.SetParam xlRange, o_ParamRange1 'シートのセルを条件値の入力場所に設定。

Param1.RefreshOnChange = True 'セルの値を変更と同時に自動更新（自動反映）する設定。

o_ParamRange1.Interior.Color = vbYellow 'そのセルを黄色にする

o_ParamRange1.Offset(0, 1).Value = "具Prm"

o_ParamRange1.Value = "%" 'ダミーデータの入力。パラメータセルが空白なことでエラーになることの回避

qt.AdjustColumnWidth = False '列幅の自動調整をOFFに。

qt.Refresh '新しいSQLの内容通りに、更新の実行。

Exit Sub

error1:

If Err.Number = 1004 Then

MsgBox "一応エラーになりましたが、" & vbCrLf & _

"SQL文は正しくて、「単にパラメータのセルに値が入っていないだけ」、かもしれません｡ " & vbCrLf & _

"" & vbCrLf & _

"このまま続行しますので、パラメータの値を全部入れてみてください。" & vbCrLf & _

"" & vbCrLf & _

" ※最初のパラメータを入れてエラーになってもそれは正常です。" & vbCrLf & _

" 　そのまますべてのパラメータを入力し続けてください。" & vbCrLf & _

" 　(空白セルが残っているためにエラーになっているだけですので。）" & vbCrLf & _

"" & vbCrLf & _

" 　ただ、日付やワイルドカート(%など）は必ず半角で入力してください。" & vbCrLf & _

"" & vbCrLf & _

"もし全てのパラメータを入力していも表が変化しなかったら、" & vbCrLf & _

"まずSQL文を、次に、各種設定を見直してみてください。"

Resume Next

Else

End If

End Sub

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

上記の「CangeQramQueryOnePrm01()」のコードのSQL部分を書き変え。

「Sheet2用」にするために、
「Set qt = Worksheets("sheet1").QueryTables(1)」を
「Set qt = Worksheets("sheet2").QueryTables(1)」に書き変え。目的のシート名に変えます。

既存のSQLに、『「大分類」などの列にパラメータを使うよ』というだけの設定を追加する。
「(具 Like ?)」を
「(大分類 Like ?)」や「(中分類 Like ?)」など、その時々に応じて書き換え。

パラメータの具体的な設定。
「s_PrmNm1 = "具Prm"」を
「s_PrmNm1 = "Prm大分類"」に書き変え。（パラメータ名の設定）

「Set o_ParamRange1 = Worksheets("sheet1").Range("G2") 」を
「Set o_ParamRange1 = Worksheets("sheet2").Range("G1") 」に。パラメータにしたいセル位置の指定。シート名を間違えないようにする。

「o_ParamRange1.Offset(0, 1).Value = "具Prm"」を
「o_ParamRange1.Offset(0, 1).Value = "大分類"」に。パラメータにしたいセルの右に、どの列をパラメータにしたかが分かりやすいように列名を入れる。

実行。

このコードは、１つのQueryTableオブジェクトに対して何回でも実行できるので、
もし、「Set o_ParamRange1 = Worksheets("sheet2").Range("G1") 」を書き間違えたら、
正しく修正して再度実行。

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

実際にセルにパラメータの値を入力して、絞り込みがちゃんと行われるかをチェック。
「%」を入れると全部表示される。（ExcelのSQLでは「%」が「ALL」の意味のワイルドカードなのｄ。）

※ただし、この時点ですでに、ファイルを再起動すると、ファイルが開く速度が遅くなります。
再計算の設定を「手動」に変えてもだめです。パラメータの値が空でもダメです。
何か遅くならない設定を見つけないといけないかもです。
ただ、パラメータの数が20個でも30個でも同じ速度で開くなら、許容範囲かもしれません。

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

２つめのQyeryTableオブジェクトの作成

「test02()」プロシージャの以下の部分を書き変え

「s_ImpCelAddr001jj = "$A$1"」を
「s_ImpCelAddr001jj = "$j$1"」に。そのシートのQTオブジェクトを生成したいセル位置を変更。シート名は同一シートなので、変更しなくていい。

「s_ChkQTobjNm01jj = "QTSht02"」を
「s_ChkQTobjNm01jj = "QTSht03"」に。新しく作るので、新しい名前にする。

同一シートの、ソースにしたいQueryTableオブジェクトの名前を指定します。
例えば、
「s_SqlStr01jj = "SELECT * FROM [Sheet2$xxxxxxx]"」を
「s_SqlStr01jj = "SELECT * FROM [Sheet2$QTSht02]"」に。
イミディエイトで
「？ Worksheets("Sheet2").QueryTables(1).name」や
「？ Worksheets("Sheet2").QueryTables(2).name」や
「？ Worksheets("sheet2").QueryTables(××).sql」などをやって、
１つ古いQueryTableオブジェクトの名前を指定します。
基本、「？ Worksheets("Sheet2").QueryTables(1)」が最新の（最後に作った）QueryTableオブジェクトの名前です。

なので、
現在１つのQueryTableオブジェクトがあるなら、「？ Worksheets("Sheet2").QueryTables(1)」が、
２つのQueryTableオブジェクトがあるなら、「？ Worksheets("Sheet2").QueryTables(2)」が、
３つのQueryTableオブジェクトがあるなら、「？ Worksheets("Sheet2").QueryTables(3)」が、
「１つ前のQueryTableオブジェクトの名前」ということになります。
「QueryTables(××)」の数字を既存のQueryTableオブジェクトの個数以上に指定すると、
「インデックスが有効範囲に無い」というエラーになります。
繰り返しますが、「？ Worksheets("sheet2").QueryTables(××).sql」などでも確認できます。

このあと、「test02」を実行します。

最初のQyeryTableオブジェクトの右側に、それをソースにしたQyeryTableオブジェクトが出来ます。

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

上記の「CangeQramQueryOnePrm01()」のコードのSQL部分を書き変え。

「Sheet2用」にするために、
「Set qt = Worksheets("sheet1").QueryTables(1)」を
「Set qt = Worksheets("sheet2").QueryTables(1)」に書き変え。目的のシート名に変えます。

※↑「QueryTables(1)」は最新のQueryTableオブジェクトを意味するので、そこの数字は変えなくてOKです。
いちおうこの時点だと、
「? Worksheets("sheet2").QueryTables(2).sql」で1つ前のQyeryTableオブジェクトのSQLがわかります。
SELECT * FROM [Sheet1$] WHERE (大分類 Like ?)

「? Worksheets("sheet2").QueryTables(1).sql」だと最新のQueryTableオブジェクトのSQL。
SELECT * FROM [Sheet2$QTSht02]

SQLのソースとなるテーブルを最新のQyeryTableオブジェクトの名前に書き変える。
s_SQLStr01 = ""
s_SQLStr01 = s_SQLStr01 & "SELECT"
s_SQLStr01 = s_SQLStr01 & " *"
s_SQLStr01 = s_SQLStr01 & " FROM"
s_SQLStr01 = s_SQLStr01 & " [Sheet2$QTSht02]" ←←←←←ココ。
s_SQLStr01 = s_SQLStr01 & " WHERE"
s_SQLStr01 = s_SQLStr01 & " (大分類 Like ?)"

上記のSQLに、『「中分類」の列にパラメータを使うよ』というだけの設定を追加する。
「(大分類 Like ?)」を「(中分類 Like ?)」に書き換え。

パラメータの具体的な設定。
「s_PrmNm1 = "Prm大分類"」を
「s_PrmNm1 = "Prm中分類"」に書き変え。（パラメータ名の設定）

「Set o_ParamRange1 = Worksheets("sheet1").Range("G2") 」を
「Set o_ParamRange1 = Worksheets("sheet2").Range("P1") 」に。パラメータにしたいセル位置の指定。シート名を間違えないようにする。

「o_ParamRange1.Offset(0, 1).Value = "大分類"」を
「o_ParamRange1.Offset(0, 1).Value = "中分類"」に。パラメータにしたいセルの右に、どの列をパラメータにしたかが分かりやすいように列名を入れる。

実行。

このコードは、１つのQueryTableオブジェクトに対して何回でも実行できるので、
もし、「Set o_ParamRange1 = Worksheets("sheet2").Range("P1") 」を書き間違えたら、
正しく修正して再度実行。

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

実際にセルに中分類の列のパラメータの値を入力して、絞り込みがちゃんと行われるかをチェック。
「%」を入れると全部表示される。（ExcelのSQLでは「%」が「ALL」の意味のワイルドカードなのｄ。）

※念のため、ここまでの状態を上書きして、ファイルを再起動。

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

入力規則（データタブ→データの入力規則アイコン）で、ドロップダウンリストを作ります。

大分類のリスト内容は手書きで「大分類,A,B,C,%」で。

中分類のリスト内容は、大分類を「%」で全表示させた状態で、
最初のQueryTableオブジェクトの「中分類」の列を、
ドラッグで縦に、普通に範囲指定。
このとき、１行目の列名も含めて選択します。リストが１行だった場合、次回にリストが１行しか表示されなくなってしまうため。
（列名を選んでもエラーにならず、自段階のリストが空白になるだけなので心配はいりません）
リスト自体は「同じ値が自動的にグループ化されて」空白行も字度的に無くなり、ドロップダウンリストに表示されるようになります。

※同左を確認出来たら、再度、念のため、ここまでの状態を上書きして、ファイルを再起動。
パラメータが増えてもファイルを開く速度の遅さは変わらないことをチェック。

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

３つめのQyeryTableオブジェクトの作成

「test02()」プロシージャの以下の部分を書き変え

「s_ImpCelAddr001jj = "$A$1"」を
「s_ImpCelAddr001jj = "$t$1"」に。そのシートのQTオブジェクトを生成したいセル位置を変更。シート名は同一シートなので、変更しなくていい。

「s_ChkQTobjNm01jj = "QTSht03"」を
「s_ChkQTobjNm01jj = "QTSht04"」に。新しく作るので、新しい名前にする。
間違わないように、事前に、数式タブの「名前の管理」でもチェックできます。
（完全に同一のものかどうかは不明ですが。QueryTableオブジェクト名と同じ名前の管理になるんですかね？？？）
そこにあるものを同じ名前を使わないようにします。

同一シートの、ソースにしたいQueryTableオブジェクトの名前を指定します。（今回の事例では１つ前のもので。）
例えば、
「s_SqlStr01jj = "SELECT * FROM [Sheet2$QTSht02]"」を
「s_SqlStr01jj = "SELECT * FROM [Sheet2$QTSht03]"」に。
イミディエイトで
「？ Worksheets("Sheet2").QueryTables(1).name」や
「？ Worksheets("Sheet2").QueryTables(2).name」や
「？ Worksheets("sheet2").QueryTables(××).sql」などをやって、
１つ古いQueryTableオブジェクトの名前を指定します。
基本、「？ Worksheets("Sheet2").QueryTables(1)」が最新の（最後に作った）QueryTableオブジェクトの名前です。
なので、
現在１つのQueryTableオブジェクトがあるなら、「？ Worksheets("Sheet2").QueryTables(1)」が、
２つのQueryTableオブジェクトがあるなら、「？ Worksheets("Sheet2").QueryTables(2)」が、
３つのQueryTableオブジェクトがあるなら、「？ Worksheets("Sheet2").QueryTables(3)」が、
「１つ前のQueryTableオブジェクトの名前」ということになります。
「QueryTables(××)」の数字を既存のQueryTableオブジェクトの個数以上に指定すると、
「インデックスが有効範囲に無い」というエラーになります。
繰り返しますが、「？ Worksheets("sheet2").QueryTables(××).sql」などでも確認できます。

このあと、「test02」を実行します。

最初のQyeryTableオブジェクトの右側に、それをソースにしたQyeryTableオブジェクトが出来ます。

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

上記の「CangeQramQueryOnePrm01()」のコードのSQL部分を書き変え。

「Sheet2用」にするために、
「Set qt = Worksheets("sheet1").QueryTables(1)」を
「Set qt = Worksheets("sheet2").QueryTables(1)」に書き変え。目的のシート名に変えます。

「? Worksheets("sheet2").QueryTables(1).sql」だと最新のQueryTableオブジェクトのSQL。
SELECT * FROM [Sheet2$QTSht02]

SQLのソースとなるテーブルを最新のQyeryTableオブジェクトの名前に書き変える。
s_SQLStr01 = ""
s_SQLStr01 = s_SQLStr01 & "SELECT"
s_SQLStr01 = s_SQLStr01 & " *"
s_SQLStr01 = s_SQLStr01 & " FROM"
s_SQLStr01 = s_SQLStr01 & " [Sheet2$QTSht03]"←←←←←ココ。
s_SQLStr01 = s_SQLStr01 & " WHERE"
s_SQLStr01 = s_SQLStr01 & " (中分類 Like ?)"

上記のSQLに、『「小分類」の列にパラメータを使うよ』というだけの設定を追加する。
「(中分類 Like ?)」を「(小分類 Like ?)」に書き換え。

パラメータの具体的な設定。
「s_PrmNm1 = "Prm中分類"」を
「s_PrmNm1 = "Prm小分類"」に書き変え。（パラメータ名の設定）

「Set o_ParamRange1 = Worksheets("sheet1").Range("G2") 」を
「Set o_ParamRange1 = Worksheets("sheet2").Range("z1") 」に。パラメータにしたいセル位置の指定。シート名を間違えないようにする。

「o_ParamRange1.Offset(0, 1).Value = "中分類"」を
「o_ParamRange1.Offset(0, 1).Value = "小分類"」に。パラメータにしたいセルの右に、どの列をパラメータにしたかが分かりやすいように列名を入れる。

実行。

このコードは、１つのQueryTableオブジェクトに対して何回でも実行できるので、
もし、「Set o_ParamRange1 = Worksheets("sheet2").Range("z1") 」を書き間違えたら、
正しく修正して再度実行。

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

入力規則（データタブ→データの入力規則アイコン）で、ドロップダウンリストを作ります。

中分類のリスト内容は、
２つめのQueryTableオブジェクトにて、中分類で一番少ないリスト数のものを表示させたうえで、
２つめのQueryTableオブジェクトの「小分類」の列を、
ドラッグで縦に、普通に範囲指定。
このとき、１行目の列名も含めて選択します。リストが１行だった場合、次回にリストが１行しか表示されなくなってしまうため。
（列名を選んでもエラーにならず、自段階のリストが空白になるだけなので心配はいりません）
リスト自体は「同じ値が自動的にグループ化されて」空白行も字度的に無くなり、ドロップダウンリストに表示されるようになります。

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

４つめののQyeryTableオブジェクトの作成

「test02()」プロシージャの以下の部分を書き変え

「s_ImpCelAddr001jj = "$z$1"」を
「s_ImpCelAddr001jj = "$ad$1"」に。そのシートのQTオブジェクトを生成したいセル位置を変更。シート名は同一シートなので、変更しなくていい。

「s_ChkQTobjNm01jj = "QTSht04"」を
「s_ChkQTobjNm01jj = "QTSht05"」に。新しく作るので、新しい名前にする。
間違わないように、事前に、数式タブの「名前の管理」でもチェックできます。
（完全に同一のものかどうかは不明ですが。QueryTableオブジェクト名と同じ名前の管理になるんですかね？？？）
そこにあるものを同じ名前を使わないようにします。

同一シートの、ソースにしたいQueryTableオブジェクトの名前を指定します。（今回の事例では１つ前のもので。）
例えば、
「s_SqlStr01jj = "SELECT * FROM [Sheet2$QTSht03]"」を
「s_SqlStr01jj = "SELECT * FROM [Sheet2$QTSht04]"」に。
イミディエイトで
「？ Worksheets("Sheet2").QueryTables(1).name」や
「？ Worksheets("Sheet2").QueryTables(2).name」や
「？ Worksheets("sheet2").QueryTables(××).sql」などをやって、
１つ古いQueryTableオブジェクトの名前を指定します。
基本、「？ Worksheets("Sheet2").QueryTables(1)」が最新の（最後に作った）QueryTableオブジェクトの名前です。
なので、
現在１つのQueryTableオブジェクトがあるなら、「？ Worksheets("Sheet2").QueryTables(1)」が、
２つのQueryTableオブジェクトがあるなら、「？ Worksheets("Sheet2").QueryTables(2)」が、
３つのQueryTableオブジェクトがあるなら、「？ Worksheets("Sheet2").QueryTables(3)」が、
「１つ前のQueryTableオブジェクトの名前」ということになります。
「QueryTables(××)」の数字を既存のQueryTableオブジェクトの個数以上に指定すると、
「インデックスが有効範囲に無い」というエラーになります。
繰り返しますが、「？ Worksheets("sheet2").QueryTables(××).sql」などでも確認できます。

このあと、「test02」を実行します。

最初のQyeryTableオブジェクトの右側に、それをソースにしたQyeryTableオブジェクトが出来ます。

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

上記の「CangeQramQueryOnePrm01()」のコードのSQL部分を書き変え。

「Sheet2用」にするために、
「Set qt = Worksheets("sheet1").QueryTables(1)」を
「Set qt = Worksheets("sheet2").QueryTables(1)」に書き変え。目的のシート名に変えます。

「? Worksheets("sheet2").QueryTables(1).sql」だと最新のQueryTableオブジェクトのSQL。
SELECT * FROM [Sheet2$QTSht02]

SQLのソースとなるテーブルを最新のQyeryTableオブジェクトの名前に書き変える。
s_SQLStr01 = ""
s_SQLStr01 = s_SQLStr01 & "SELECT"
s_SQLStr01 = s_SQLStr01 & " *"
s_SQLStr01 = s_SQLStr01 & " FROM"
s_SQLStr01 = s_SQLStr01 & " [Sheet2$QTSht04]"←←←←←ココ。
s_SQLStr01 = s_SQLStr01 & " WHERE"
s_SQLStr01 = s_SQLStr01 & " (小分類 Like ?)"

上記のSQLに、『「小々分類」の列にパラメータを使うよ』というだけの設定を追加する。
「(小分類 Like ?)」を「(小々分類 Like ?)」に書き換え。

パラメータの具体的な設定。
「s_PrmNm1 = "Prm中分類"」を
「s_PrmNm1 = "Prm小分類"」に書き変え。（パラメータ名の設定）

「Set o_ParamRange1 = Worksheets("sheet1").Range("z1") 」を
「Set o_ParamRange1 = Worksheets("sheet2").Range("aj1") 」に。パラメータにしたいセル位置の指定。シート名を間違えないようにする。

「o_ParamRange1.Offset(0, 1).Value = "小分類"」を
「o_ParamRange1.Offset(0, 1).Value = "小々分類"」に。パラメータにしたいセルの右に、どの列をパラメータにしたかが分かりやすいように列名を入れる。

実行。

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

入力規則（データタブ→データの入力規則アイコン）で、ドロップダウンリストを作ります。

中分類のリスト内容は、
２つめのQueryTableオブジェクトにて、中分類で一番少ないリスト数のものを表示させたうえで、
２つめのQueryTableオブジェクトの「小々分類」の列を、
ドラッグで縦に、普通に範囲指定。
このとき、１行目の列名も含めて選択します。リストが１行だった場合、次回にリストが１行しか表示されなくなってしまうため。
（列名を選んでもエラーにならず、自段階のリストが空白になるだけなので心配はいりません）
リスト自体は「同じ値が自動的にグループ化されて」空白行も字度的に無くなり、ドロップダウンリストに表示されるようになります。

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

★注意！！！

自ファイルの内容を段階的に見ているせいか、一応、ファイル名やパスが変わるとダメっぽいです。

その場合、SQLを書く直すか、リスト自体を作り直す必要があるかもです。

投稿タグ: 「ニセモノ」への道, 「本物」に近づくために, AccessVBA, Accessの独学, Access操作の基礎, Accesの独学, ADO／DAO, ExcelSQL, ExcelVBA, Excelの独学, Excel操作の基礎, Excel連携VBA, MicrosoftQuery, ODBC, SQL, パソコンでの自動化, マクロ, 独学, 自動化

MENU

関連記事

最近の投稿

カテゴリー

MENU

★★★★★★Excel2000VBA独学～★★★★★★ 『 SQL の学習用 』の続き ★★★★★★～ 「パラメータクエリ」を使って、ドロップダウンを段階的に絞り込む実験～

関連記事

最近の投稿

カテゴリー

タグ

★★★★★★Excel2000VBA独学～★★★★★★　『 SQL の学習用』の続き ★★★★★★～「パラメータクエリ」を使って、ドロップダウンを段階的に絞り込む実験～