Excel VBA質問箱 IV

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

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


5324 / 76732 ←次へ | 前へ→

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

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

一例として。
作業シートとして "Sheet2" を使います。
抽出そのものは、あオートフィルターや重複の削除といったエクセル標準機能を使っています。

書きなぐったので、同じような処理コードが何回も出てきます。
このあたりは整理して共通サブルーティン化もできるところでしょう。

Option Explicit

Dim rfA As Range
Dim rfX As Range

Private Sub CommandButton1_Click()
  Dim WS As Worksheet
  Dim x As Long
  
  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

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 x As Long
  
  If ComboBox4.ListIndex < 0 Then Exit Sub
  
  For x = 1 To 8
    OLEObjects("CheckBox" & x).Object.Value = False
    OLEObjects("CheckBox" & x).Object.Enabled = False
  Next
  i = ComboBox4.List(ComboBox4.ListIndex, 1)
  z = Cells(i, Columns.Count).End(xlToLeft).Column
  For j = 5 To z
    x = 0
    Select Case Cells(i, j).Value
      Case "祖父"
        x = 3
      Case "祖母"
        x = 4
      Case "父"
        x = 1
      Case "母"
        x = 2
      Case "兄"
        x = 5
      Case "姉"
        x = 6
      Case "弟"
        x = 7
      Case "妹"
        x = 8
    End Select
    
    If x > 0 Then
      OLEObjects("CheckBox" & x).Object.Value = True
      OLEObjects("CheckBox" & x).Object.Enabled = True
    End If
  Next
  
End Sub

744 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 発言[未読]

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