『チェックボックスの使い方』（グッチー） A1のセルの横にチェックボックスを表示させチェックを付けた物を他のセルに 表示させる方法を教えて下さい。 ---- チェックを付けた物というのは、A1セルの値のことですか？ チェックボックスは、コントロールツールボックスのもので構わないですか？ チェックボックスは、全部で何個くらい使いますか？ (INA) ---- A1･A2･････のセルの横にチェツクボックスを付けてチェツクを実行すると A1･A2･････の値が他のセルに反映されるようにしたいんですが 　　　A　　　　　　　　　D　　　E 　1 リンゴ　　　　　　　リンゴ＝　合計 　2 ミカン　　　　　　　ミカン＝　合計 　3 バナナ　　　　　　　バナナ＝　合計　 　4 リンゴ　　　　　　　　・　　 　5 リンゴ　　　　　　　　・ 　6 バナナ　　　　　　　　・ 　7 バナナ 　　　･ 　　　･ 上記のように表示したいんです >チェックボックスは、コントロールツールボックスのもので構わないですか？ 構いません >チェックボックスは、全部で何個くらい使いますか？ 13個位です お願いします　 （グッチー） ---- 「表示」＞「ツールバー」＞「フォーム」のチェックボックスで説明します。 B1にチェックボックスを作り、右クリック「コントロールの書式設定」でコントロール のタブの「リンクするセル」をB1にします。 E1に=IF(B1,COUNTIF($A$1:$A$13,A1),"")とします。 B1のフォントの色は白くしておけばTRUE、FALSEの文字が見えなくなります。 （ケン） ---- ありがとうございました、できました。もう一つ聞きたいんですが 下記のようにした場合 A1からA10　C1からC10まで値が入力されています BとDにチェツクボックスを作ります、値の多い順にEに名前F合計 を表示するようにしたいんですが、教えて下さい。 　　A　　　　　　B　　　　　C　　　　　D　　　　　　E　　　　　F 　1 リンゴ　　　　　　リンゴ　　　　　　　リンゴ 7　 　2 ミカン　　　　　　バナナ　 ミカン 6 　3 バナナ　　　　　　ミカン　 バナナ 6 　4 リンゴ　　　　　　ミカン　 メロン 1　　 　5 リンゴ　　　　　　リンゴ　　 　6 バナナ　　　　　　バナナ　　 　7 バナナ ミカン 　 8 リンゴ　　　　　　リンゴ 　 9 ミカン　　　　　　バナナ 10メロン　　　　　　ミカン (グッチー） ---- すべて自動で、ですか？VBAの出番かなぁ？（ケン） ---- 　出来れば自動で願いします。（グッチー） ---- 今の私は少々時間がかかりそうです。出来るとも限りません。VBAにたけた人が いっぱいいます。お待ちください。（ケン）私も諦めた訳ではないです。 ---- チェックボックスをたくさん配置すると、かなり重たくなるけど １３個くらいなら平気かな。 軽くするときはダブルクリックイベントで、 セルにレ点をON/OFFさせるという方法もあるけど・・ いまちょっといそがしいので時間が空いたら考えてみます。 (INA) ---- 今考えていたのですが、分からない所があります。 B列とD列にチェックを入れた物だけのカウントですか？ B1だけにチェックしたらリンゴは1ですか？（ケン） ---- A1:D20にデータがあるとします。B1:B10、D1:D10には、各左側と右側のチェックボックスに 対応する論理値がリンクしているものとしています。 G1:G4に上からリンゴ、ミカン、バナナ、メロンとします。 H1に=COUNT(IF(A$1:C$10=G1,IF(B$1:D$10,)))*100+ROW(A1)として、Ctrl+Shift+Enter。 これをG4までフィルドラッグ。これらは、作業セルです。 E1に=INDEX(G$1:G$4,MOD(LARGE(H$1:H$4,ROW(A1)),100))、 F1に=INT(LARGE(H$1:H$4,ROW(A1))/100)。 E1:F1をE4:F4までフィルドラッグ。ということでは、どうでしょう？ 同順は、下の行を大としています。　　　　　　　　　　　　　　　 (LOOKUP) ---- 項目自体をＷクリックして色つけして判別させれば、 Ｂ列、Ｄ列も要らなく出来るな・・・ (INA) ---- 相変わらずLOOKUPさんの発想には驚かされます。 *すごいな〜。 （ケン） ---- 有難う御座いました、イメージどうりの物ができました。 参考に　INAさんのやり方も教えて下さい。 （グッチー） ---- もう一つ質問なんですが、チエックが無いもの値が０の物は 表示しないようにするには、どうすればいいか教えて下さい。 (グッチー） ---- G5に=COUNTIF(H1:H4,">100")。 F1に=IF(ROW(A1)>G$5,"",INT(LARGE(H$1:H$4,ROW(A1))/100))、 E1に=IF(F1="","",INDEX(G$1:G$4,MOD(LARGE(H$1:H$4,ROW(A1)),100)))。 として、E1:F1をE4:F4までフィルドラッグです。　　(LOOKUP) ---- 本当にありがとうございました。 　（グッチー） ---- >参考に　INAさんのやり方も教えて下さい。 こんな感じです。必要であれば「並び替え」の処理を追加しても良いかと思います。 １．ALT+F11キーで、VBEを起動 ２．プロジェクトウィンドウのSheet1 を Ｗクリック ３．中央の真っ白なウィンドウ（コードウィンドウ）に以下のコードをコピペ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim myRange As Range Dim FindData As Range Dim c As Range Set myRange = Range("A1:A10,C1:C10") If Application.Intersect(Target, myRange) Is Nothing Then Exit Sub Cancel = True 'セル入力モード無効 '色のON/OFF If Target.Interior.ColorIndex = 34 Then Target.Interior.ColorIndex = xlColorIndexNone Else Target.Interior.ColorIndex = 34 End If '項目追加 For Each c In myRange If c.Interior.ColorIndex <> xlColorIndexNone Then Set FindData = Range("E:E").Find(c.Value, LookIn:=xlValues, LookAt:=xlWhole) If FindData Is Nothing Then If Range("E1").Value = "" Then Range("E1").Value = c.Value Else Range("E65536").End(xlUp).Offset(1) = c.Value End If End If End If Next c Range("F:F").ClearContents '色数カウント For Each c In myRange If c.Interior.ColorIndex <> xlColorIndexNone Then Set FindData = Range("E:E").Find(c.Value, LookIn:=xlValues, LookAt:=xlWhole) If Not FindData Is Nothing Then FindData.Offset(0, 1).Value = FindData.Offset(0, 1).Value + 1 End If End If Next c 'カウント0の項目の削除 For Each c In Range(Cells(1, 5), Cells(65536, 5).End(xlUp)) If c.Value <> "" And c.Offset(0, 1).Value = 0 Then c.Resize(, 2).Delete Shift:=xlUp End If Next c End Sub (INA) ---- 　INAさん有難う御座いました、 　話は戻りますが、LOOKUPさんに教えて頂いた方法で作成した、チェツクボックスに 　ボタン一つでチェツクを表示させたり、消したりする方法も教えて下さい！！ 　（グッチー） ---- なんということをおっしゃるのですか。もともと、そのようになっているでしょう？　 テストは、どのようにされたのでしょう？　 　　　　 B1:B10、D1:D10の行高を広げ、フォームのチェックボックスを２０個配置して、 それぞれのコントロールの書式をクリックし、リンクするセルにB1:B10、D1:D10を 指定してください。 (LOOKUP)