VBA 複数のCheckBoxの組み合みせについて

Question

抽出するキーをチェックボックスで選択し、オートフィルターのデータ集計方法について教えてください。

入力項目を制御できるように、例えば、「りんごなら本当はこの項目は選べない」という条件によって選択できないようにして、所望のデータを抽出したいです。
実際はチェックボックスが３０個くらいあります。本来チェックボックスで出来るのかもわかりません。

<Sheet1> 

![

やりたいこと
<Sheet1>にデータがあり、ユーザーフォームでチェックボックスからユーザーに選択してもらい、<Sheet3>に所望のデータをどんどん追加して貼り付けていくようにしようとしています。

不明点
チェックボックスの組み合わせを本来望む値との対応表を作り、マクロを作成していこうと思います。
例えば商品を”りんご”、サイズ”S”、産地”AA"を選んだら問題ないけど、商品を”なし”、サイズ”L”、は選択の書き方が分からなくてつまずいています。すみませんがサンプルとなるような記載方法について教えてください。

Dim myFld1 As String, myCri As String
Dim myRow As Long
Dim Sh1 As Worksheet, Sh2 As Worksheet, Sh3 As Worksheet
Set Sh1 = Worksheets("Sheet1")
Set Sh2 = Worksheets("Sheet2")
Set Sh3 = Worksheets("Sheet3")
    
    'チェックボックスの組み合わせを作る
    
    With Sh1
    
    If .CheckBoxes(1).Value = りんご Then
    ElseIf .CheckBoxes(5).Value = S Then
    ElseIf .CheckBoxes(8).Value = AA Then
  
    Else     
    End If

   myFld = 1
   myCri = UserForm1.CheckBox.Value  
　
With Sh1
　　　　’Sh1のデータをオートフィルターする
　　　　.Range("A1").AutoFilter Field:=myFld, Criteria1:=myCri
　　　　myRow = .Range("A" & Rows.Count).End(xlUp).Row
　　　　.Range("A1:D" & myRow).Copy 
        .Sh3.Range("A").Offset(1).PasteSpecial Paste:=xlPasteAll  
　　　　.Sh1.Range("A1").AutoFilter
　　End With

　　Sh3.Activate
　　Range("A1").Select

End Sub

Answer 1

フレームとオプションボタンですと、こんなことできます。
各列のフィルター値取得セットできると思います

フレームを配置し、各フレーム内に必要個数のOptionButtonを配置しています。
Frame1 上から　OptionButton１から４
Frame2 上から　OptionButton５から７
Frame3 上から　OptionButton8から14
です。

Private Sub CommandButton1_Click()
  Dim Control1 As Control
  Dim Control2 As Control
  Dim Control3 As Control
  
  For Each Control1 In Frame1.Controls
    If Control1.Value = True Then Exit For
  Next
  For Each Control2 In Frame2.Controls
    If Control2.Value = True Then Exit For
  Next
  For Each Control3 In Frame3.Controls
    If Control3.Value = True Then
      MsgBox Control1.Caption & "_" & Control2.Caption & "_" & Control3.Caption
      Exit For
    End If
  Next
End Sub

追記、

Private Sub OptionButton1_AfterUpdate()
  Call Chk1
End Sub

Private Sub OptionButton2_AfterUpdate()
  Call Chk1
End Sub

Private Sub OptionButton3_AfterUpdate()
  Call Chk1
End Sub

Private Sub OptionButton4_AfterUpdate()
  Call Chk1
End Sub
Sub Chk1()
  Dim Control1 As Control
  Dim Control2 As Control
  Dim Chk As Boolean
  Dim myRange As Range
  Dim myObj As Range
  Dim keyWord As String
  Set myRange = Range("A:A")
  
  For Each Control1 In Frame1.Controls
    If Control1.Value = True Then
      Chk = True
      Exit For
    End If
  Next
  If Chk = True Then
    For Each Control2 In Frame2.Controls
      keyWord = Control1.Caption & "_" & Control2.Caption & "_*"
      Set myObj = myRange.Find(keyWord, LookAt:=xlWhole)
      If myObj Is Nothing Then
        Control2.Enabled = False
        Control2.Value = False
      Else
        Control2.Enabled = True
        Control2.Value = False
      End If
    Next
    For Each Control3 In Frame3.Controls
      Control3.Enabled = False
      Control3.Value = False
    Next
  End If
End Sub

Private Sub OptionButton5_AfterUpdate()
  Call Chk2
End Sub

Private Sub OptionButton6_AfterUpdate()
  Call Chk2
End Sub
Private Sub OptionButton7_AfterUpdate()
  Call Chk2
End Sub
Sub Chk2()
  Dim Control1 As Control
  Dim Control2 As Control
  Dim Control3 As Control
  Dim Chk As Boolean
  Dim myRange As Range
  Dim myObj As Range
  Dim keyWord As String
  Set myRange = Range("A:A")
  
  For Each Control1 In Frame1.Controls
    If Control1.Value = True Then Exit For
  Next
  For Each Control2 In Frame2.Controls
    If Control2.Value = True Then
      Chk = True
      Exit For
    End If
  Next
  If Chk = True Then
    For Each Control3 In Frame3.Controls
      keyWord = Control1.Caption & "_" & Control2.Caption & "_" & Control3.Caption
      Debug.Print keyWord
      Set myObj = myRange.Find(keyWord, LookAt:=xlWhole)
      If myObj Is Nothing Then
        Control3.Enabled = False
        Control3.Value = False
      Else
        Control3.Enabled = True
        Control3.Value = False
      End If
    Next
  End If
End Sub

追記２
下記コードでフレームとオプションボタンの位置関係わかります。
フレーム名とその中にあるオプションボタンが
Frame3-OptionButton8のように表示されます。

Frame3と、その下に-OptionButton8から14つながっていますでしょうか？

Sub test01()

Dim MyCtrl As Object
Dim InCtrl As Object
Dim MyStr  As String
  With UserForm1
    For Each MyCtrl In .Controls
      If InStr(MyCtrl.Name, "Frame") > 0 Then
        For Each InCtrl In MyCtrl.Controls
          MyStr = MyStr & MyCtrl.Name & "-" & InCtrl.Name & vbCrLf
        Next
      End If
        MyStr = MyStr & MyCtrl.Name & vbCrLf
    Next
    MsgBox MyStr
  End With
End Sub

Comments

[koko2]

回答ありがとうございました。初めて作成するのでもう少し教えてください。
Control1、2と今回作成しようとしている選択１番目（商品名）、２番目（サイズ）はどう結び付けるのか、私には難しいので教えて下さい。

[koko2]

詳しく説明頂きありがとうございました。フォームを同じに作成し、追記頂いたように再現してみたのですが、商品のボタンを押したとたんにデバックとなってしまい、For Each Control3 In Frame3.Controlsでひっかかってしまいました。原因が分かりませんので教えて頂けるでしょうか。

[sinzou]

１． 図（差し替えました）のように配置しています。確認お願いします。
２．CommandButton1_Click()修正差し替えました。

[koko2]

修正して頂きありがとうございました。再度再現してみたのですが、同じところFor Each Control3 In Frame3.Controlsで、実行時エラー ‘424’: オブジェクトが必要です。とのメッセージです。私の設定で必要なものがあるのでしょうか。

[sinzou]

追記２、行いました
UserForm上のコントロールの配置　確認お願います。

[koko2]

無事できました。UserFormの説明頂きありがとうございます。フォームの設定間違いしていることに気づかせていただきました。コードも非常にわかりやすく、今後に活かせていけると思います。回答頂き、ありがとうございました。

Answer 2

こんばんは。少し強引ですがコンボボックスの連動のみCollectionを使って作ってみました。
あまり時間をかけれずコードが汚いので、調整をお願いします。
また。今回は、オートフィルターのデータ集計方法はふれていません。

メインシート：master
セルA列～D列
Userform1
Combobox1:商品名
Combobox2:サイズ
Combobox3:産地

Private Sub ComboBox2_Change()

Dim MyData3 As New Collection
Dim cnt3 As Long
Dim i3 As Long

    
cnt3 = Sheets("master").Range("A1").CurrentRegion.Rows.Count

商品名 = ComboBox1.Text
サイズ = ComboBox2.Text

ComboBox3.Clear

    On Error Resume Next
    For i3 = 2 To cnt3
    
      If Sheets("master").Range("B" & i3).Value = 商品名 Then
      
        If Sheets("master").Range("C" & i3).Value = サイズ Then
            MyData3.Add Sheets("master").Range("D" & i3).Value, Sheets("master").Range("D" & i3).Value
        End If
    End If
    
    Next i3
    On Error GoTo 0
        
    For i3 = 1 To MyData3.Count
    
      ComboBox3.AddItem MyData3(i3)
    Next

 
End Sub
Private Sub ComboBox1_Change()
Dim MyData2 As New Collection
Dim cnt2 As Long
Dim i2 As Long

    
cnt2 = Sheets("master").Range("A1").CurrentRegion.Rows.Count

商品名 = ComboBox1.Text

ComboBox2.Clear

    '■重複しない商品名のリストを作成（エラーを無視）
    On Error Resume Next
    For i2 = 2 To cnt2
    
      If Sheets("master").Range("B" & i2).Value = 商品名 Then
        
        MyData2.Add Sheets("master").Range("C" & i2).Value, Sheets("master").Range("C" & i2).Value
    End If
    
    Next i2
    On Error GoTo 0
      
    '■商品名のリストを作成
    
    For i2 = 1 To MyData2.Count
    
      ComboBox2.AddItem MyData2(i2)
    Next

 
End Sub

Private Sub UserForm_Initialize()
Dim MyData1 As New Collection

Dim cnt As Long
Dim i As Long

    cnt = Sheets("master").Range("A1").CurrentRegion.Rows.Count
    
    '■重複しない商品名のリストを作成（エラーを無視）
    On Error Resume Next
    For i = 2 To cnt

        MyData1.Add Sheets("master").Range("B" & i).Value, Sheets("master").Range("B" & i).Value

    Next i
    On Error GoTo 0
      
    '■商品名のリストを作成
    
    For i = 1 To MyData1.Count
    
      ComboBox1.AddItem MyData1(i)
    Next

End Sub

Listboxで作るとこんな感じでしょうか・・・・。
コードはコンボがリストボックスに
なっただけでほぼ同じです。

＜初回の投稿＞
拝見しました。チェックボックスの組み合わせですがチェックボックスは複数選択が可能なので
現実的ではないような気がします。

他の記事ではコンボボックスが連動するように作られているようです。
Excel VBA 複数(2つ)のコンボボックスに連動するリストを登録する

VBA使うならシンプルな方法がいいので、参考にされると良いかと思います。

Comments

[koko2]

回答ありがとうございました。参考のサイトを確認させていただきます。

[koko2]

お忙しいところ再度解答を頂きありがとうございました。自分でも上記を再現して勉強させて頂きます。だいぶ近いものになりそうです。