Excel2007 多くの選択肢の中から選択されたものだけを別のシートに表示させたい

質問

エクセル2007を使用しています。
sheet1に100社ほどの会社のリストがあります。A列に社名、B列にフォームコントロールから作成したチェックボックスをつけています。
この中から選ばれた(チェックの入った)3社の社名を、sheet2のA～C列にそれぞれ会社1、会社2、会社3という項目をつけ、その下の行に表示させたいと思っています。
どのような方法があるでしょうか。教えていただけると助かります。
よろしくお願いします。

回答No.5

imogasi

＃３です。
質問者には難しすぎると思うが、興味あれば、参考に。
Sub test01()
Dim objOLE As OLEObject
Dim i As Long
X = Array("", "AA", "BB", "CC", "DD", "EE", "FF", "GG", "HH", "II", "JJ")
'画面更新を一時的にOFF
Application.ScreenUpdating = False
For i = 1 To 3
'コントロールを追加する
Set objOLE = Worksheets("Sheet3") _
.OLEObjects.Add("Forms.CheckBox.1")
objOLE.Object.Caption = X(i) 'Captionを設定
objOLE.Left = Cells(i + 1, "B").Left '横位置を設定
objOLE.Top = Cells(i + 1, "B").Top '縦位置を設定
objOLE.LinkedCell = ""
objOLE.LinkedCell = "A" & (i + 1)
Next
'画面更新をONに戻す
Application.ScreenUpdating = True
End Sub
これで３つのチェックボックスをシート（Ｓｈｅｅｔ３）のＢ列のＢ２以下に貼り付け
Ａ２：Ａ５に各々ＬｉｎｋｅｄＣｅｌｌを設定し、好みのＣａｐｔｉｏｎを設定する。Ｃａｐｔｉｏｎの文言はＡｒｒａｙで定義している。
＝＝＝
コントロール群の中のＣｈｅｃｋＢｏｘの判別は
Sub test01()
Dim obj As Object
MsgBox Worksheets("Sheet3").OLEObjects.Count
For Each obj In Worksheets("Sheet3").OLEObjects
'MsgBox obj.Name
'MsgBox obj.progID
If obj.progID = "Forms.CheckBox.1" Then
MsgBox obj.progID & "がチェックボックス"
End If
Next
End Sub

回答No.4

fujillin

#2です。

ちょっと、いい加減だったので修正しました。
（B列は使用しないようにしました。）
ついでに、指定する個数を変更できるようにしてあります。
（nMaxの数値が、選択されるはずの個数です）

個数が違っても、一応コピーしますが（指定個数と選択個数の小さい個数分コピー）、アラートがでます。

Sub test()
Dim obj As Object, o As Object, sht As Worksheet
Dim tmp() As Long, rwMax As Long, tval As Long
Dim nMin As Integer, n As Integer, tind As Integer
Dim i As Integer, j As Integer

Const sht1 = "sheet1" '//←リストのあるシート名
Const sht2 = "sheet2" '//←表示させるシート名
Const nMax = 3　　　　'//←コピーする会社数の最大

Set sht = Worksheets(sht2)
n = 0

With Worksheets(sht1)
　rwMax = .Cells(Rows.Count, 1).End(xlUp).Row
　Set obj = .OLEObjects

'//チェックボックスを捜査
　For Each o In obj
　　If o.progID = "Forms.CheckBox.1" And o.Object.Value = "True" Then
　　　If o.TopLeftCell.Row <= rwMax Then
　　　　n = n + 1
　　　　ReDim Preserve tmp(1 To n)
　　　　tmp(n) = o.TopLeftCell.Row
　　　End If
　　End If
　Next o

'//チェックされた会社名をコピー
　sht.Rows("1:2").ClearContents　'//←表示用シートの1,2行をクリア
　If n < nMax Then nMin = n Else nMin = nMax
　For i = 1 To nMin
　　tval = rwMax + 1
　　For j = 1 To n
　　　If tmp(j) < tval Then tind = j: tval = tmp(j)
　　Next j
　　sht.Cells(1, i).Value = "会社" & i
　　sht.Cells(2, i).Value = .Cells(tmp(tind), 1).Value
　　tmp(tind) = rwMax + 1
　Next i
End With

'//チェック数の確認
If (n > nMax) Then MsgBox ("選択した個数が多すぎます。（" & n & "個選択）")
If (n < nMax) Then MsgBox ("選択した個数が少ないです。（" & n & "個選択）")
End Sub

回答No.3

imogasi

シート上に貼り付けたコントロールは、そのままではシートのセルの値にならず、扱いにくい。だからエクセルのコントロールのプロパティには、ＬｉｎｋｅｄＣｅｌｌがあるが、
チェックボックスが多数あると、手動で１つ１つＬｉｎｋｅｄＣｅｌｌの設定が面倒。
ＶＢＡでたるにも初心者には難しい。
（１）シート上のチェックボックスの捕らえ方
（２）チェックボックスであることの判別　　
（３）そのシート内の数
（４）順次Ａ１，Ａ２などにＬｉｎｋｅｄＣｅｌを設定していく方法
（５）もっと言えばコードでチェックボックスを作成し、位置を
適当にセルにあわせる
などできないといけないが、難しいだろう。
ーーーー
初心者なのに難しいやり方を採用して、判らないので他人を頼っている。格好よいと思ったのかもしれないが、身の丈にあった方法を使うべきだ。
Ｂ列に、抜き出しする会社を指定する「１」などを入れるようにし、
Ｂ列に１の入った行をＳｈｅｅｔ２に抜き出す、とでもするのが相応しい。
これは私が答えている「imogasi方式」による抜き出し方式が使える。
例データ
Ｓｈｅｅｔ１
Ａ１：Ｃ６
Ａ列　　　Ｂ列　　　Ｃ列
会社名 抜き出し 該当連番
田中商店
今井靴店　 1 1
鈴木化成
木村木材
松井衣料　 1 2
ーー
Ｃ２の式　=IF(B2=1,MAX($C$1:C1)+1,"")
下方向に式を複写。
Ｓｈｅｅｔ２に行って
Ａ２に　=INDEX(Sheet1!$A$1:$A$6,MATCH(ROW()-1,Sheet1!$C$1:$C$6,0),1)
ＲＯＷ（）－１は、Ｓｈｅｅｔ２で第２行目から表示させるためー１が必要。
下方向に式を複写する。
多数行に式を複写しておく場合は、＃Ｎ／Ａを出させないよう
=IF(ROW()-1>MAX(Sheet1!$C$1:$C$6),"",INDEX(Sheet1!$A$1:$A$6,MATCH(ROW()-1,Sheet1!$C$1:$C$6,0),1))
結果
今井靴店
松井衣料
Ｓｈｅｅｔ１のＣ列以右に会社のデータがあっても、式を少し変えれば、Ｓｈｅｅｔ２に持ってこれる。

回答No.2

fujillin

細部が不明なところもありますが、説明も面倒なのでとりあえず作ってみました。一応、こんな感じでしょうか？

・リストの順にA、B、C列に記入するために一度チェックしておいてから、
　後でコピーする方式にしてあります。
　（チェックボックスが順になているとは限らないので）
・Ｂ列にはチェックボックスがあるので、セル自体は使用していないと想像
　して、チェックがある場合の一時的な控え場所として利用しています。
（" "を記入しています。もしも、セルを利用している場合は、別の列に
　するか、配列に控えるなどに変更する必要があります。）
・チェックボックスの位置を取得するのにTopLeftCellを使用していますので
　左上が他の行に跨っていたりすると、1行をずれて解釈してしまう可能性
　があります。
・＞sheet2のA～C列にそれぞれ～～～
　sheet2の1行目が「会社1」など、2行目が会社名と解釈しました。

説明はどこまですればよいのかわからないので、とりあえずなしです。
標準モジュールなどにおいて、実行してみてください。
（必ずテスト用のデータでテストしてください）

Sub test()
Dim obj As Object, o As Object
Dim sht As Worksheet, rw As Long, rwMax As Long, n As Integer
Const sht1 = "sheet1"　 '//←リストのあるシート名
Const sht2 = "sheet2"　 '//←表示させるシート名
Set sht = Worksheets(sht2)
n = 0

With Worksheets(sht1)
　rwMax = .Cells(Rows.Count, 1).End(xlUp).Row
　.Columns("B").ClearContents
　Set obj = .OLEObjects

'//チェックボックスを捜査
　For Each o In obj
　　If o.progID = "Forms.CheckBox.1" And o.Object.Value = "True" Then
　　　.Cells(o.TopLeftCell.Row, 2).Value = " "
　　　n = n + 1
　　End If
　Next o
　If n <> 3 Then
　　MsgBox ("選択個数が3個ではありません。（" & n & "個選択されています）")
　　Exit Sub
　End If

'//チェックされた会社名をコピー
　n = 1
　For rw = 1 To rwMax
　　If .Cells(rw, 2).Value = " " Then
　　　.Cells(rw, 2).Value = ""
　　　sht.Cells(1, n).Value = "会社" & n
　　　sht.Cells(2, n).Value = .Cells(rw, 1)
　　　n = n + 1
　　End If
　Next rw
End With
End Sub

回答No.1

fujillin

＞フォームコントロールから作成したチェックボックス
というのは、コントロールツールのチェックボックスのことですよね？
(2003での回答ですが…）

◆方法1
1.各チェックボックスの値を、どこかの列にリンク（ボックスの位置と同じ
　行に）させておく。（この列は非表示にしておいても良い）
2.あとはチェックの入っているセルを見て、別シートに表示
　（方法は過去の質問に、類似のものが沢山あると思う）

◆方法2
チェックボックスのリンクなどが面倒であれば、全てマクロで片付ける方法
1.sheet1上のチェックボックスを順に調べてチェックが入っていたら、その
　位置から行を割り出す。
2.その行のデータをsheet2へ転記する
3.チェックボックスを全て調べたら終わり。

両方の方法とも、「3社の社名」というチェック数が3であることはチェックしていないが、方法2ならこれも簡単にチェックできる。

お礼

早速のご回答ありがとうございます！
チェックボックスのリンクは、数が多いので少し手間がかかります。
方法2の具体的なやり方について教えていただけませんでしょうか？
ちなみにマクロやVBAは初心者です。。。すみません。