VBA データの転記、参照の方法

質問

VBAの課題に取り組んでいます。
社内にあるパソコンの貸し出し、廃棄、登録などの情報を管理するシステムを作っています。パソコンは将来追加されていくものとします。
今書こうとしている処理が以下のとおりです。
１．ホーム（検索画面）のチェックボックスでPCのOSを選択
２．PCテーブルを参照して、条件に該当するOSのPC情報を、検索結果画面（別のシート）にデータを反映する

質問は(1)～(3)の3点です。
(1)PCテーブルを参照し、チェックされている条件に当てはまるPCの情報を検索結果画面に転記するための処理をどう書いたらよいかわからないです。
(2)検索画面のElseIf以降のコードの書き方がわからないですが、Win8,Win7,WinXPがチェックされた場合も、Windows10をチェックしたときのIF文と同様の書き方でいいのでしょうか？
(3)何もチェックしていないときは「OSを選択してください」とメッセージが出るようにしたいですが、書き方がわからないです。

他に修正し、追加するべきところがあったら是非教えてください。　
よろしくお願いいたします。

(1)ホーム（検索画面）のコード
Private Sub cmdSearch_Click() '検索ボタンを押す
Dim nStartRow As Integer '開始行
Dim nEndRow As Integer '終了行
nStartRow = 3 'OSの列
nEndRow = PCT.Cells(Rows.Count, 3).End(xlUp).Row 'Tb最後

For Row = nStartRow To eEndRow
If cbWin10.Value Then 'Win10のボックスをチェックした場合
If (PCT.Cells(Rows.Count, 3) = "Windows10") Then
Result.Activate '検索結果表示
End If
PCT.Cells("B2:E2" & maxRow).Value = Result("B5:E5" & maxRow).Value
’PCT（PCテーブルのシート）、Result(検索結果のシート)
　'Win10のPC情報を転記する
'Else: If cbWin8.Value Then　Win8の場合
End If
Next Row
If cbWin10 = flase '何もチェックしないとき
else cbWin8=false
else cbWin7=false
else cbWinXP=false Then
MsgBox "OSを選択してください"
Exit Sub
End Sub

(2)PCテーブルの画面
パソコン番号 OS 状態 　　　　返却期限 借りている人
1 WindowsXP 貸し出し可能
2 Windows8 修理中
3 Windows7 廃棄
4 Windows7 貸し出し中 2026/2/16
5 Windows10 故障
6 Windows8 貸し出し中 2017/5/3
7…　（将来PCの追加予定） …

(3)検索結果画面
　　番号　 OS 　　状態 　返却期限　借りている人
5 Windows10　 故障

回答No.4

kkkkkm · ベストアンサー

フォームコントロールのチェックボックスでしたら

Dim c As Shape
Dim flg As Boolean

For Each c In ActiveSheet.Shapes
If c.Type = msoFormControl Then
If c.Name Like "cb*" Then
If CheckBoxes(c.Name).Value = xlOn Then
Select Case c.Name
Case "cbWin10"
flg = True
Call SearchPC("Windwos10")

お礼

丁寧に教えてくださり、ありがとうございます！
少しずつ自分で勉強して理解を深めます。

回答No.6

imogasi

質問の方法と違うのですが、下記の方を勉強してください。勧めます。
普通の解説書なら、こうではないかという方法を使った。質問の方法は、泥臭い方法と感じて、その為に色色質問が出る、と感じたから。
今までの回答者は、質問者の質問路線での、部分訂正の教示の回答がほとんどだが、小生は、回答者の今後のためには、広げた勉強が必要と思う。
ーー
Sheet1のA,B列に、例データとして
PCID OS
PC1 windows10
PC2 windows10
PC3 windows7
PC4 windows10
PC5 windows8
PC6 windows10
’－－－
ユーザーフォームにオプションボタンを５つほど設ける（OSの種類数に合わせてである）。
CaptionはOS名（B列の表記の通り、一字一句同じにする）。
ElseIfの行はそれに合わせて増やすこと。
そのユーザーフォームに、コマンドボタンを１つ設ける。
コマンドボタンのクリックイベントに
Private Sub CommandButton1_Click()
Worksheets("Sheet1").Range("B1").AutoFilter
With UserForm1
If .CheckBox1.Value = True Then
検索語 = CheckBox1.Caption
ElseIf .CheckBox2.Value = True Then
検索語 = CheckBox2.Caption
ElseIf CheckBox3.Value = True Then
検索語 = CheckBox3.Caption
Else
MsgBox "どれかを選択してください。"
End If
End With
MsgBox 検索語
'---シート検索
Worksheets("Sheet1").Range("B2").AutoFilter Field:=2, Criteria1:=検索語, VisibleDropDown:=False
Worksheets("Sheet1").Range("A1").CurrentRegion.Copy Worksheets("Sheet2").Range("A1")
End Sub
結果
Sheet2
PCID OS
PC1 windows10
PC2 windows10
PC4 windows10
PC6 windows10
Sheet2データを用いた、その後の処理はご自由に。

お礼

確かに私が当初考えていた処理よりもわかりやすいですね。
オートフィルタの機能を初めて知ったので活用しようと思います。
ありがとうございます。

回答No.5

kkkkkm

最初の方だけ変更してください
Call SearchPC("Windwos10")
までを変更して後はそのままです。

> f c.Object.Value = True Then　'IFはそれぞれのOSの場合を書く？

OleObjectをシート上で検索して名前がcbで始まるものであればそれがチェックされているかどうか見て、チェックされていればそのチェックボックスがどのチェックボックスなのかを
Select Case c.Name
以降で判断してOS名を引数に入れて
SearchPC(ByVal SelectPC As String)
を実行します。
VBA Select Caseで検索してそのやり方を確認してください。

チェックボックスの確認ができているかどうかの確認のため
下の方の　Function SearchPC　を以下のようにしてボタンを押したときにチェックボックスに対応したOS名が渡されているかどうか見てください。

Function SearchPC(ByVal SelectPC As String)
MsgBox SelectPC
End Function

> また、検索したデータを転記するにはどのような命令を使うといいでしょうか？

右辺を左辺に代入するです。
PCT（PCテーブルのシート）からResult(検索結果のシート)に転記なら
Result.Cells(Row,Column).value=PCT.Cells(Row,Column).value

以後コードについてやテストの仕方の説明はしませんので関数などの使い方は検索してください。

回答No.3

kkkkkm

ユーザーフォームではなくて直接シートにチェックボックスだったのですね。
ActiveXコントロールでしたら（最初の方だけ変更してください)
cにはFor~Nextで順次コントロールオブジェクトが入ります。

Dim c As OLEObject
Dim flg As Boolean

flg = False
For Each c In ActiveSheet.OLEObjects
If c.Name Like "cb*" Then
If c.Object.Value = True Then
Select Case c.Name
Case "cbWin10"
flg = True
Call SearchPC("Windwos10")

補足

そのとおりです。チェックボックスをのせてます。
説明不足ですみません。
以下のようにまとめておきました。
If c.Name Like "cb*" ThenからEndIFまでは同じ要領で
それぞれのOSの場合を書けばよろしいですか？
また、検索したデータを転記するにはどのような命令を使うといいでしょうか？

Private Sub cmdSearch_Click() '検索ボタンを押す

Dim c As OLEObject
Dim flg As Boolean

flg = False
For Each c In ActiveSheet.OLEObjects
If c.Name Like "cb*" Then
If c.Object.Value = True Then　'IFはそれぞれのOSの場合を書く？
Select Case c.Name
Case "cbWin10"
flg = True
Call SearchPC("Windows10")
End Select
End If
If c.Object.Value = True Then　　
Select Case c.Name
Case "cbWin8"
flg = True
Call SearchPC("Windows8")
End Select
End If
Next

If flg = False Then
MsgBox "OSを選択してください", vbCritical
End If
End Sub

Function SearchPC(ByVal SelectPC As String)

Dim nStartRow As Long '開始行
Dim nEndRow As Long '終了行
Dim mRow As Long

nStartRow = 3 'OSの列
nEndRow = PCT.Cells(Rows.Count, 3).End(xlUp).Row 'Tb最後

For mRow = nStartRow To eEndRow
If PCT.Cells(mRow, 3) = SelectPC Then
Result.Activate '検索結果表示
'データの転記コード
End If
Next

End Function

回答No.2

kkkkkm

チェックボックスだと以下のような感じでも
Function SearchPC(ByVal SelectPC As String)はNo1と同じで

Private Sub cmdSearch_Click()
Dim c As Control
Dim flg As Boolean

flg = False
For Each c In Controls
If TypeName(c) = "CheckBox" Then
If c.Value = True Then
Select Case c.Name
Case "cbWin10"
flg = True
Call SearchPC("Windwos10")
Case "cbWin8"
flg = True
Call SearchPC("Windwos8")
Case "cbWin7"
flg = True
Call SearchPC("Windwos7")
Case "cbWinXP"
flg = True
Call SearchPC("WindwosXP")
Case Else

End Select
End If
End If
Next
If flg = False Then
MsgBox "OSを選択してください", vbCritical
End If
End Sub

補足

素早い回答ありがとうございます！
ちなみに、c=nothingとなったのですが、Controlsのcには何を代入すればよいのでしょうか？

回答No.1

kkkkkm

コンボボックスで選択するようにして以下のようにすると単純になると思います。

Private Sub cmdSearch_Click()
If ComboBox1.Value <> "" Then
Call SearchPC(ComboBox1.Value)
Else
MsgBox "OSを選択してください", vbCritical
End If

End Sub

Function SearchPC(ByVal SelectPC As String)
Dim nStartRow As Long '開始行
Dim nEndRow As Long '終了行
Dim mRow As Long

nStartRow = 3 'OSの列
nEndRow = PCT.Cells(Rows.Count, 3).End(xlUp).Row 'Tb最後

For mRow = nStartRow To eEndRow
If PCT.Cells(mRow, 3) = SelectPC Then
Result.Activate '検索結果表示
データの転記コード
End If
Next

End Function