Excel VBA質問箱 IV

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

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


5323 / 76732 ←次へ | 前へ→

【77022】Re:コンボボックスとチェックボックスの連動に関する質問
発言  β  - 15/5/6(水) 21:56 -

引用なし
パスワード
   ▼mohimohi さん:

アップしたコードでは、項目名をコンスタントでチェック(祖父とか父とか)し
かつ、祖父なら CheckBox● と決めつけしています。
実際にはこれでいいのかもしれませんが、E列からI列に記入する項目名がかわれば
コードも変える必要がでてきます。
また、チェックボックスの数に増減があれば、コードを変更する必要がでてきます。

以下は、そのような時、コードを変えず、E列からI列に記入する項目名と
チェックボックスのキャプションを同じにしておけば、自動判定しますし、
チェックボックスの増減も任意です。

アップ済みコードと全く同じプロシジャもありますが、フルセット掲載します。

Option Explicit

Dim rfA As Range
Dim rfX As Range
Dim dic As Object

Private Sub CommandButton1_Click()
  Dim WS As Worksheet
  Dim x As Long
  Dim ckb As OLEObject
  
  Set WS = Sheets("Sheet2")
  ComboBox2.Clear
  ComboBox3.Clear
  ComboBox4.Clear
  ComboBox1.Value = ""
  ComboBox2.Value = ""
  ComboBox3.Value = ""
  ComboBox4.Value = ""
  
  WS.UsedRange.Clear
  WS.AutoFilterMode = False
  Range("A1").CurrentRegion.Columns("A:D").Copy WS.Range("A1")
  WS.Range("E1").Value = 1
  WS.Range("A1").CurrentRegion.Columns("E").DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Step:=1, Trend:=False
  WS.Range("A1").AutoFilter
  Set rfA = WS.AutoFilter.Range
  Set rfX = WS.Cells(rfA.Rows.Count + 2, "A")
  WS.Range("A1").CurrentRegion.Columns("A").Copy WS.Range("G1")
  WS.Range("G1").CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlYes
  With WS.Range("G1").CurrentRegion
    ComboBox1.List = .Offset(1).Resize(.Count - 1).Value
  End With
    For x = 1 To 8
    OLEObjects("CheckBox" & x).Object.Value = False
    OLEObjects("CheckBox" & x).Object.Enabled = False
  Next

  If dic Is Nothing Then
    Set dic = CreateObject("Scripting.Dictionary")
    For Each ckb In OLEObjects
      If TypeName(ckb.Object) = "CheckBox" Then dic(ckb.Object.Caption) = ckb.Name
    Next
  End If
  
End Sub

Private Sub ComboBox1_Change()

  If ComboBox1.ListIndex < 0 Then Exit Sub
  
  ComboBox2.Clear
  ComboBox3.Clear
  ComboBox4.Clear
  ComboBox2.Value = ""
  ComboBox3.Value = ""
  ComboBox4.Value = ""
  
  rfA.AutoFilter Field:=1, Criteria1:=ComboBox1.Value
  If rfA.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count = 1 Then Exit Sub
  rfX.CurrentRegion.Clear
  Intersect(rfA, rfA.Offset(1)).Copy rfX
  rfX.CurrentRegion.RemoveDuplicates Columns:=2, Header:=xlNo
  With rfX.CurrentRegion.Columns("B")
    ComboBox2.List = .Value
  End With
  
End Sub

Private Sub ComboBox2_Change()

  If ComboBox2.ListIndex < 0 Then Exit Sub
  
  ComboBox3.Clear
  ComboBox4.Clear
  ComboBox3.Value = ""
  ComboBox4.Value = ""
  
  rfA.AutoFilter Field:=1, Criteria1:=ComboBox1.Value
  rfA.AutoFilter Field:=2, Criteria1:=ComboBox2.Value
  If rfA.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count = 1 Then Exit Sub
  rfX.CurrentRegion.Clear
  Intersect(rfA, rfA.Offset(1)).Copy rfX
  rfX.CurrentRegion.RemoveDuplicates Columns:=3, Header:=xlNo
  With rfX.CurrentRegion.Columns("C")
    ComboBox3.List = .Value
  End With
  
End Sub

Private Sub ComboBox3_Change()

  If ComboBox3.ListIndex < 0 Then Exit Sub
  
  ComboBox4.Clear
  ComboBox4.Value = ""
  
  rfA.AutoFilter Field:=1, Criteria1:=ComboBox1.Value
  rfA.AutoFilter Field:=2, Criteria1:=ComboBox2.Value
  rfA.AutoFilter Field:=3, Criteria1:=ComboBox3.Value
  If rfA.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count = 1 Then Exit Sub
  rfX.CurrentRegion.Clear
  Intersect(rfA, rfA.Offset(1)).Copy rfX
  With rfX.CurrentRegion.Columns("D:E")
    ComboBox4.List = .Value
  End With
  
End Sub

Private Sub ComboBox4_Change()
  Dim i As Long
  Dim j As Long
  Dim z As Long
  Dim ckName As String
  Dim k As Variant
  
  If ComboBox4.ListIndex < 0 Then Exit Sub
  
  For Each k In dic
    With OLEObjects(dic(k)).Object
      .Value = False
      .Enabled = False
    End With
  Next
  i = ComboBox4.List(ComboBox4.ListIndex, 1)
  z = Cells(i, Columns.Count).End(xlToLeft).Column
  For j = 5 To z
    If dic.exists(Cells(i, j).Value) Then
      With OLEObjects(dic(Cells(i, j).Value)).Object
        .Value = True
        .Enabled = True
      End With
    End If
  Next
  
End Sub

743 hits

【77005】コンボボックスとチェックボックスの連動に関する質問 mohimohi 15/5/5(火) 0:04 質問[未読]
【77006】Re:コンボボックスとチェックボックスの連... β 15/5/5(火) 6:42 発言[未読]
【77009】Re:コンボボックスとチェックボックスの連... mohimohi 15/5/5(火) 11:36 回答[未読]
【77012】Re:コンボボックスとチェックボックスの連... β 15/5/5(火) 13:50 発言[未読]
【77014】Re:コンボボックスとチェックボックスの連... mohimohi 15/5/5(火) 18:56 回答[未読]
【77016】Re:コンボボックスとチェックボックスの連... β 15/5/5(火) 19:27 発言[未読]
【77017】Re:コンボボックスとチェックボックスの連... mohimohi 15/5/5(火) 19:59 回答[未読]
【77018】Re:コンボボックスとチェックボックスの連... β 15/5/5(火) 20:19 発言[未読]
【77020】Re:コンボボックスとチェックボックスの連... mohimohi 15/5/5(火) 21:46 お礼[未読]
【77021】Re:コンボボックスとチェックボックスの連... β 15/5/6(水) 7:46 発言[未読]
【77040】Re:コンボボックスとチェックボックスの連... mohimohi 15/5/9(土) 20:40 質問[未読]
【77045】Re:コンボボックスとチェックボックスの連... β 15/5/10(日) 6:21 発言[未読]
【77048】Re:コンボボックスとチェックボックスの連... mohimohi 15/5/10(日) 11:35 発言[未読]
【77051】Re:コンボボックスとチェックボックスの連... β 15/5/10(日) 14:10 発言[未読]
【77052】Re:コンボボックスとチェックボックスの連... mohimohi 15/5/10(日) 14:54 発言[未読]
【77053】Re:コンボボックスとチェックボックスの連... β 15/5/10(日) 15:25 発言[未読]
【77054】Re:コンボボックスとチェックボックスの連... mohimohi 15/5/10(日) 17:07 お礼[未読]
【77055】Re:コンボボックスとチェックボックスの連... β 15/5/10(日) 17:33 発言[未読]
【77056】Re:コンボボックスとチェックボックスの連... mohimohi 15/5/10(日) 18:04 お礼[未読]
【77060】Re:コンボボックスとチェックボックスの連... mohimohi 15/5/11(月) 23:27 発言[未読]
【77061】Re:コンボボックスとチェックボックスの連... β 15/5/12(火) 10:08 発言[未読]
【77064】Re:コンボボックスとチェックボックスの連... β 15/5/12(火) 19:10 発言[未読]
【77065】Re:コンボボックスとチェックボックスの連... β 15/5/12(火) 19:14 発言[未読]
【77066】Re:コンボボックスとチェックボックスの連... β 15/5/12(火) 19:54 発言[未読]
【77073】Re:コンボボックスとチェックボックスの連... mohimohi 15/5/13(水) 8:13 お礼[未読]
【77074】Re:コンボボックスとチェックボックスの連... β 15/5/13(水) 9:14 発言[未読]
【77075】Re:コンボボックスとチェックボックスの連... β 15/5/13(水) 15:51 発言[未読]
【77076】Re:コンボボックスとチェックボックスの連... mohimohi 15/5/13(水) 23:08 お礼[未読]
【77077】Re:コンボボックスとチェックボックスの連... β 15/5/14(木) 1:19 発言[未読]
【77078】Re:コンボボックスとチェックボックスの連... mohimohi 15/5/14(木) 5:44 発言[未読]
【77022】Re:コンボボックスとチェックボックスの連... β 15/5/6(水) 21:56 発言[未読]
【77023】Re:コンボボックスとチェックボックスの連... mohimohi 15/5/6(水) 22:17 お礼[未読]
【77013】Re:コンボボックスとチェックボックスの連... β 15/5/5(火) 13:56 発言[未読]
【77007】Re:コンボボックスとチェックボックスの連... γ 15/5/5(火) 10:04 発言[未読]
【77010】Re:コンボボックスとチェックボックスの連... mohimohi 15/5/5(火) 11:43 回答[未読]
【77011】Re:コンボボックスとチェックボックスの連... γ 15/5/5(火) 13:44 発言[未読]
【77015】Re:コンボボックスとチェックボックスの連... mohimohi 15/5/5(火) 19:17 お礼[未読]
【77019】Re:コンボボックスとチェックボックスの連... γ 15/5/5(火) 20:59 発言[未読]

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