「教えて!ピックアップ」リリース!

《やりたい事》
下記のデータから、平均の列から100点を取った生徒の学級・出席番号・氏名を抽出して
これらのデータをExcelの別のファイルのシートに表示させたい。

マクロ作成を希望するExcelデータ

学年ごとのファイル
3学年の朝テスト国語のデータ 
学年ごとに1年用というファイルに Excel15学級分のシートがある
学年ごとに2年用というファイルに Excel15学級分のシートがある
学年ごとに3年用というファイルに Excel13学級分のシートがある

シートの様式
B列に出席番号         B4~B45     
C列に生徒名          C4~C45         
( D列~K列は個別の点数が入っている   D4~K45 ) 
L列に得点の平均         L4~L45          
C列の1行目に学級名     C1

質問者からの補足コメント

  • fname = Application.GetOpenFilename("Excel ブック,*.xls?")
    "Excel ブック,*.xls?".xlsxのファイルです。そこで、ここに1年・2年・3年の全てのファイル名を入れればいいのですか。よくわからず、すみません。お教え下さいませんか。よろしくお願い致します。

    No.4の回答に寄せられた補足コメントです。 補足日時:2022/11/05 06:54

A 回答 (8件)

こんばんは #4#5です


6様に同感です
今後、使用用途を考えるとVBAで特定の処理が出来ても
応用するにはそれなりの作り込みが必要になると思いますので実用的ではありませんね 
もしVBAを使うにしても複数のブックを1ブックに纏めるところで済ませた方が良いと思います

データ構成に解らない所がありますが、
#4でコードを示しましたついでに(複数ブックを)纏める処理を書きました
VBAで出来たブックに手を加えるのが良いのかなと思います
A列は学級別のフィルタキーに使うかも知れないので対象範囲に出力しました
学年はシートで分けています
(イデントで分かり難いですがコメントも付けました)

Sub test0()
Dim ExlFile As Workbook 'ターゲットブック
Dim newExlBk As Workbook '新規ブック
'複数ファイルピッカー MultiSelect:=True
'ダイアログでファイルを複数選択する
Dim openFilesPath As Variant
openFilesPath = Application.GetOpenFilename _
("Microsoft Excel ファイル,*.xls*", , "学年ファイルを選んで下さい", MultiSelect:=True)
Dim tmp As Integer '新規シート数設定の一時保存用
Dim cuntFiles As Integer '選択ファイル数
Dim i As Integer '配列用ループ変数
If IsArray(openFilesPath) Then 'ピッカーキャンセル対応(Variant配列確認)
cuntFiles = UBound(openFilesPath) 'ファイル数を代入(配列の最大インデックス)
Application.ScreenUpdating = False 'ちらつき抑制
'新しいブックを作る----
tmp = Application.SheetsInNewWorkbook '既存新規シート数設定を取得
Application.SheetsInNewWorkbook = cuntFiles '新規シート数をファイル数で設定
Set newExlBk = Workbooks.Add '新規ブック作成
Application.SheetsInNewWorkbook = tmp '新規シート数を元に戻す
'-------
Dim rw As Long 'データ出力行№用
Dim sht As Worksheet 'シート変数
Dim r As Range 'データ範囲用変数

For i = 1 To cuntFiles '選択ファイル数でループ
' ファイル(配列インデックス)で新規ブックのシートを確定し名前を付ける
newExlBk.Sheets(i).Name = Split(Dir(openFilesPath(i)), ".")(0)
' 対象を開いて変数にセット
Set ExlFile = Workbooks.Open(openFilesPath(i))
'対象ブックの各シートからデータを取得、コピー
For Each sht In ExlFile.Worksheets
'新規ブックの最終行の1つ下
rw = newExlBk.Sheets(i).Cells(Rows.Count, 2).End(xlUp).Offset(1).Row
With sht
'データ範囲B4~L列のB列最終行
Set r = .Range(.Cells(4, 2), .Cells(.Rows.Count, 2).End(xlUp)).Resize(, 11)
r.Copy newExlBk.Sheets(i).Cells(rw, 2)
'C1学級名をA列のデータ出力行に
newExlBk.Sheets(i).Cells(rw, 1).Resize(r.Rows.Count).Value = sht.Range("C1").Value
End With
Next
'対象ブックを閉じる
ExlFile.Close False
Next i
Application.ScreenUpdating = True
End If
Set ExlFile = Nothing
Set newExlBk = Nothing
End Sub
    • good
    • 0
この回答へのお礼

完成できました。大変丁寧にお教え頂きありがとうございました。

お礼日時:2022/11/09 19:12

No.6です。



補足です。
全員のデータを一つにまとめたあと、連番の列を追加しておくと、点数上位順に並べ替えなどしたあとで元の並び順に戻すことができるので便利です。
出席番号など既存のもので代用できるものがあれば必要ないのですが念のため。
    • good
    • 0
この回答へのお礼

完成できました。大変丁寧にお教え頂きありがとうございました。

お礼日時:2022/11/09 19:12

現状は学年・学級でファイル・シートが分かれていますが、一つにまとめたほうがよいです。


いまからでも遅くないので、これを機会に一つのシートで管理する形にすることをおすすめします。年度ごとに新しくするのがよいです。

◆手順
1.全員のデータを一つのファイルの一つのシートにコピペしていきます。
2.必須ではありませんが、学年、学級を記入する列を追加します。B列の出席番号で学年、学級の区別がつくと思いますが、作っておくと後々便利です。
3.3行目が項目行になっていると思います。3行目を行選択して、メニュー⇒データ⇒フィルタ、とします。これにより特定の条件により抽出して表示することができます。
4.L3セルにある『▼』マークをクリックして『100』のみにチェックを入れてOKとします。これにより100点の人のみが抽出できます。
5.シート全体をコピーして、別のファイルのシートに貼り付けます。

・フィルター機能を使うことにより、学年ごと、学級ごとに抽出して表示できます。
・SUBTOTAL関数を使うとフィルターで表示されているデータのみの演算(最大、最小、平均、標準偏差、など)が容易にだせます。
・学校の成績管理に使われているなら、少なくとも1学年1シートにするほうがよいと思います。(カモフラージュならスルーしてください)
    • good
    • 0
この回答へのお礼

大変丁寧にお教え頂きありがとうございました。

お礼日時:2022/11/09 19:12

こんにちは


#4のコードは1ファイル(1学年)ずつ処理を行うようになっています

従って出力も1学年1ブックに纏められます
>ファイル名を入れればいいのですか
ファイルを選択してOKを押す形ですが・・GetOpenFilenameを使わない場合はファイルフルパスでもOKです

3学年すべてを纏めて処理を行いたい場合は繰り返し処理などを追加する必要があります
また、学年ごとにシートを分け1ブックに纏めるなどの処理を加えた方が良いかも知れませんね

ただ、これくらい(1つずつ)にしておいた方が使い勝手が良いかも知れないと思います
先ずは、1ファイルで正しく処理できるかを確認した方が良いと思います
    • good
    • 0
この回答へのお礼

大変丁寧にお教え頂きありがとうございました。

お礼日時:2022/11/09 19:12

こんばんは


VBAでやる場合でも色々手順があると思いますので 1例です

Sub sample()
Dim fname As String
Dim tp As Integer
Dim ExlFile As Workbook
Dim newExlBk As Workbook
fname = Application.GetOpenFilename("Excel ブック,*.xls?")
If fname = "False" Then Exit Sub
Application.ScreenUpdating = False
tp = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Set newExlBk = Workbooks.Add
ActiveSheet.Name = Split(Dir(fname), ".")(0)
Application.SheetsInNewWorkbook = tp
Set ExlFile = Workbooks.Open(fname)
Dim sht As Worksheet, r As Range
Dim rw As Long
For Each sht In ExlFile.Worksheets
rw = newExlBk.Sheets(1).Cells(Rows.Count, 2).End(xlUp).Offset(1).Row
With sht
If Not .AutoFilterMode Then .Cells(3, "B").AutoFilter
Set r = .Range(.Cells(4, 2), .Cells(Rows.Count, 2).End(xlUp)).Resize(, 11)
r.AutoFilter 12, 100
r.Copy newExlBk.Sheets(1).Cells(rw, 2)
newExlBk.Sheets(1).Cells(rw, 1).Value = sht.Range("C1").Value
.Cells(3, "B").AutoFilter
End With
Next
ExlFile.Close False
Application.ScreenUpdating = True
Set ExlFile = Nothing
Set newExlBk = Nothing
End Sub

上のコードは新規ブックを作り標準モジュールを追加してそのモジュールにコピペして使います
VBAを実行するとファイル選択ダイアログが表示されますので 対象のブックを選びます
選んだブックの各シート(すべてのシート)を対象に繰り返し処理で新規ブックにコピー処理が行われます

コードを書いたブック 対象のデータブック データをまとめた新規ブック

繰り返し処理:データの範囲にフィルタをかけ L列を対象に100でデータを絞り結果を新規ブックのシート最終行に貼り付けを繰り返します

1行目は詰めていません
学級名はA列に出力
対象ファイルのシートはデータシートのみがあると想定しています
一応、シート名をファイル名にしました
エラー処理はしていません
フィルタの設定は r.AutoFilter 12, 100 です 12列目 100 
100は数値が入っていると想定
対象ファイルは、データ取得後保存せずに閉じています
この回答への補足あり
    • good
    • 0
この回答へのお礼

完成できました。大変丁寧にお教え頂きありがとうございました。

お礼日時:2022/11/09 19:13

各ブックの書式の添付がありませんので添付画像のように仮に設定しました。


生徒の試験結果を入力するブック名を「国語1年.xlsx」などとしクラスごとのシート名を「Class1」「Class2」などとします。添付画像の上は「国語1年」の「Class2」で他のシートも同じフォーマットにします。
ブック名は「国語1年.xlsx」のように学年以外を揃えてください。ブック名が決まったら、マクロの「ファイル名を取得する」の次にある「国語」を決めた名前に合わせてください。文字列の学年のある位置に合わせて数字を変更してください。「国語1年.xlsx」は左から2文字が「国語」なので
 Left(nowGradeBook, 2) = "国語"
としています。「1年試験」などであれば
 Right(nowGradeBook, 2) = "試験"
として共通なものを拾い出してください。ここでは点数の書かれたブック以外の処理を飛ばす処理をしています。
次に学年を取り出すのに
 Do While nowGradeBook <> ""
の中の
 grade = Mid(Workbooks(nowGradeBook).Name, 3, 1)
で3文字目の1文字を取り出しています。違うブック名であれば学年数の位置を Left、 Right、 Mid で指定してください。
シート名は「1組」のように数字+文字または文字+数字で文字は揃えてください。シート名はブックの中で繰り返し処理をしますのでシート名のクラス数字以外は揃えてください。シート名が決まったら「出席番号を基準に順次処理」の中にある
 class = Right(nowWorksheet.Name, 1)
でクラス数の位置を指定してください。「Class1」の場合最後がスラス番号なので上のようになります。「1組」なら
 class = Left(nowWorksheet.Name, 1)
「1年1組」なら
 class = Mid(nowWorksheet.Name, 3, 1)
になります。

転記集計するブック名を「国語集計.xlsm」としてここにマクロを書き込みます。学年ごとのブックとマクロを含むブック4ファイルを同じフォルダーに入れます。
「国語集計」の2行目5列目以降の得点(添付画像の場合100~90)は集計する得点を入力しておきます。100点だけで良ければ100だけ入力しておきます。平均点なので小数点以下が出るので小数点以下を四捨五入しています。

マクロは Sub sumUpPoint() 以下を「国語集計」の「ThisWorkbook」に貼り付けます。マクロはできるだけコメントを入れましたのでおわかりになると思います。

【注意】
1.変数定義のあとにある初期化の消去範囲は書式を変えたときに数値を変更してください。
2.マクロ実行時は全ファイルを開いてからマクロを実行してください。ご存知だと思いますがメニュー「開発」ー「マクロ」で「ThisWorkbook.sumUpPoint」を選んで「実行」ボタンです。
3.何度も実行しましたがエラーが出るようならその箇所をお知らせください。


Sub sumUpPoint()
'
Dim thisSheet As Worksheet '
Dim nowGradeBook As String '
Dim nowWorksheet As Worksheet '
' 学年ファイル名
Dim firstGrade As String
Dim secondGrade As String
Dim thirdGrade As String
'
Dim setPoint As Range ' 集計する点数の行範囲
Dim point As Integer ' 点数
Dim grade As Integer ' 学年
Dim class As Integer ' クラス
Dim sh As Integer ' クラスのシート名
Dim i, c, r
'
Set thisSheet = ThisWorkbook.Worksheets(1) ' この集計ブック
'
With thisSheet
' 初期化(すでにある入力値を消去)
r = .Cells(2000, 2).End(xlUp).Row + 1
.Range(.Cells(3, 2), .Cells(r, 15)).Delete
'
' フォルダー内にあるファイル名を取得する
nowGradeBook = Dir("*.xlsx")
If Left(nowGradeBook, 2) = "国語" Then
Do While nowGradeBook <> ""
' 学年をブック名から取得する(学年の数字を切り出す)
' 今のケースでは "国語1年.xlsx" なので3文字目1文字
grade = Mid(Workbooks(nowGradeBook).Name, 3, 1)
i = 3 ' 集計シートの記入行始まり
' クラスごとの処理(シート別)
For sh = 1 To Workbooks(nowGradeBook).Worksheets.Count
' 出席番号を基準に順次処理
Do
Set nowWorksheet = Workbooks(nowGradeBook).Worksheets(sh)
' クラスをシート名から取得する(クラスの数字を切り出す)
' 今のケースでは "Class1" なので右の1文字
' "1組" なら Left(nowWorksheet.Name, 1) となる
class = Right(nowWorksheet.Name, 1)
point = nowWorksheet.Cells(i, 12) ' 平均点
' 点数により書き込む列番号c、行番号rを2行目から探す
Set setPoint = .Range(.Cells(2, 5), .Cells(2, 16)). _
Find(point, LookAt:=xlWhole)
If Not (setPoint Is Nothing) Then ' 値のないものは無視
c = setPoint.Column
r = .Cells(100, 2).End(xlUp).Row + 1
' 値の書き込み
.Cells(r, 2) = grade ' 学年
.Cells(r, 3) = class ' 組
.Cells(r, 4) = nowWorksheet.Cells(i, 2) ' 番号
.Cells(r, c) = nowWorksheet.Cells(i, 3) ' 名前
End If
i = i + 1
Loop While (nowWorksheet.Cells(i, 2)) <> ""
i = 3
Next
' 次のファイル名を取得
nowGradeBook = Dir()
Loop
End If
End With
End Sub
「マクロか関数で処理したいのですが、教えて」の回答画像3
    • good
    • 0
この回答へのお礼

完成できました。大変丁寧にお教え頂きありがとうございました。

お礼日時:2022/11/09 19:13

「マクロか関数で」とありますが シートを分けている時点で数式での


解決は諦めたほうがいいでしょう。

手段としてはマクロかクエリのどちらかです。

ただマクロは自分で作る気がないなら外注するか手を出さないかのどち
らかしかありません。質問板で誰かに一から作らせてもメンテナンスで
きる人がいなければ早晩破綻します。そもそもこの説明で作ったマクロ
がデバッグなしでまともに動くわけがありませんし。

どうしてもマクロもクエリも勉強したくないということなら表の作り方
を見直す(全部1シートにまとめてから抽出する)以外ないと思います。
    • good
    • 0
この回答へのお礼

お教え頂きありがとうございました。

お礼日時:2022/11/09 19:13

学年・クラスを項目に追加して、全部の行を1シートにまとめる。


列で並べ替えて手作業で抽出した方が早い。
    • good
    • 0
この回答へのお礼

お教え頂きありがとうございました。

お礼日時:2022/11/09 19:13

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング