ＥＸＣＥＬの検索結果を別シートに貼り付けたい

質問

学校で事務を行っています。

成績の管理をエクセルで行っているのですが、特定の生徒について成績データを
取り出したく、質問をお願いします。m(_ _)m

作成した成績データSheetのうち、番号を指定した生徒について、成績取込Ｓｈｅｅｔに
教科コードが一致する教科の点数・生徒番号・生徒氏名をＶＢＡを使用して貼り付け
たいのですが、どのようすればよいでしょうか？

よろしくお願いいたします。

回答No.1

tom04 · ベストアンサー

こんにちは！
画像がはっきり確認できないのですが、
「成績取込」Sheetにユーザーフォームを配置しているのでしょうか？

今回はユーザーフォームではなく、「成績取込」SheetのA1セルに「生徒番号」を入力してマクロを実行する方法にしてみました。
尚、「成績取込」SheetのA・B列は入力済みだとします。

Alt＋F11キー　→　メニュー　→　挿入　→　標準モジュール　→　VBE画面に
↓のコードをコピー＆ペーストしてマクロを実行してみてください。

Sub 抽出()
Dim i As Long, k As Long, endRow As Long, wS1 As Worksheet, wS2 As Worksheet
Set wS1 = Worksheets("成績データ")
Set wS2 = Worksheets("成績取込")
endRow = wS2.Cells(Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False
Range(wS2.Cells(5, "C"), wS2.Cells(endRow, "E")).ClearContents
For k = 5 To wS2.Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To wS1.Cells(Rows.Count, "A").End(xlUp).Row
If wS1.Cells(i, "C") = wS2.Range("A1") And wS1.Cells(i, "A") = wS2.Cells(k, "A") Then
With wS2.Cells(k, "C")
.Value = wS1.Cells(i, "C")
.Offset(, 1) = wS1.Cells(i, "D")
.Offset(, 2) = wS1.Cells(i, "E")
End With
End If
Next i
Next k
Application.ScreenUpdating = True
End Sub

こんな感じではどうでしょうか？m（_ _）m

お礼

ご回答いただきありがとうございます。

教えていただいたとおりに実行したところ、無事に動きました。

本当に助かりました。

回答No.3

keithin

画像ではよく見えませんが，生徒番号を何かに記入させるようにしてるのですか。

とりあえずシート上に配置したアクティブＸコントロールのテキストボックスに記入する事にします。
ユーザーフォームをわざわざ表示しているのでしたら，適切に応用して下さい。

手順：
テキストボックスのプロパティでリンクするセルをＢ２セルに設定する
Ｃ５セルには
=IF(COUNTIFS(成績シート!A:A,A5,成績シート!C:C,$B$2)=1,$B$2,"")
と記入，以下コピーしておく

Ｄ５セルには
=IF(C5="","",VLOOKUP(C5,成績シート!C:D,2,FALSE))
と記入，以下コピーしておく

Ｅ５セルには
=IF(C5="","",SUMIFS(成績シート!E:E,成績シート!A:A,A5,成績シート!C:C,C5))
と記入，以下コピーしておく

以上でＢ２セルにリンクさせた生徒番号により，所定の内容が現れます。マクロを使うまでもありません。
（ワークシート上，つまりＢ２セルに直接生徒番号を記入するように作成した方が，もっと簡単ですが）

＞マクロ

以上の段取りをマクロで実現します
せっかくなのでテキストボックスのチェンジイベントで自動駆動してみます。

private sub TextBox1_Change()
　if application.countif(worksheets("成績シート").range("C:C"), textbox1.value)>0 then
　　range("B2") = textbox1.value
　　range("C5:C17").formula = "=IF(COUNTIFS(成績シート!A:A,A5,成績シート!C:C,$B$2)=1,$B$2,"""")
　　range("D5:D17").formula = "=IF(C5="""","""",VLOOKUP(C5,成績シート!C:D,2,FALSE))"
　　range("E5:E17").formula = "=IF(C5="""","""",SUMIFS(成績シート!E:E,成績シート!A:A,A5,成績シート!C:C,C5))"
　　range("C5:E17").value = range("C5:E17").value
　end if
end sub

テキストボックスに記入すると，自動反映します。

回答No.2

hallo-2007

まるで、フィルターオプションを使ってみてくださいと
云わんばかりの質問ですね。
http://www.eurus.dti.ne.jp/~yoneyama/Excel/filter3.htm
のサイトに説明があります。
最後の方にＶＢＡのコードもありますし、マクロの記録で十分な形が得られます。