マクロか関数で処理したいのですが、教えて頂けませんか。

Question

《やりたい事》
下記のデータから、平均の列から１００点を取った生徒の学級・出席番号・氏名を抽出して
これらのデータをExcelの別のファイルのシートに表示させたい。

マクロ作成を希望するExcelデータ

学年ごとのファイル
３学年の朝テスト国語のデータ　
学年ごとに1年用というファイルに　Excel１５学級分のシートがある
学年ごとに２年用というファイルに　Excel１５学級分のシートがある
学年ごとに３年用というファイルに　Excel１３学級分のシートがある

シートの様式
B列に出席番号　　　　　　　　　B４～B４５　　　　　
C列に生徒名　　　　　　　　　　C４～C４５　　　　　　　　　
      ( D列～K列は個別の点数が入っている   　　D４～K４５ )　
L列に得点の平均　　　　　　　　　L４～L４５　　　　　　　　　　
C列の１行目に学級名　      　　　C１

Qchan1962 · Accepted Answer

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

データ構成に解らない所がありますが、
＃４でコードを示しましたついでに(複数ブックを）纏める処理を書きました
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)
'C１学級名を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

googoo900 · Answer

No.6です。

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

googoo900 · Answer

現状は学年・学級でファイル・シートが分かれていますが、一つにまとめたほうがよいです。
いまからでも遅くないので、これを機会に一つのシートで管理する形にすることをおすすめします。年度ごとに新しくするのがよいです。

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

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

Qchan1962 · Answer

こんにちは
＃４のコードは１ファイル（1学年）ずつ処理を行うようになっています

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

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

ただ、これくらい（１つずつ）にしておいた方が使い勝手が良いかも知れないと思います
先ずは、1ファイルで正しく処理できるかを確認した方が良いと思います

Qchan1962 · Answer

こんばんは
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は数値が入っていると想定
対象ファイルは、データ取得後保存せずに閉じています

duffer_dog · Answer

各ブックの書式の添付がありませんので添付画像のように仮に設定しました。生徒の試験結果を入力するブック名を「国語１年.xlsx」などとしクラスごとのシート名を「Class1」「Class２」などとします。添付画像の上は「国語１年」の「Class２」で他のシートも同じフォーマットにします。ブック名は「国語１年.xlsx」のように学年以外を揃えてください。ブック名が決まったら、マクロの「ファイル名を取得する」の次にある「国語」を決めた名前に合わせてください。文字列の学年のある位置に合わせて数字を変更してください。「国語１年.xlsx」は左から２文字が「国語」なので　Left(nowGradeBook, 2) = "国語" としています。「１年試験」などであれば　Right(nowGradeBook, 2) = "試験" として共通なものを拾い出してください。ここでは点数の書かれたブック以外の処理を飛ばす処理をしています。次に学年を取り出すのに　Do While nowGradeBook <> "" の中の　grade = Mid(Workbooks(nowGradeBook).Name, 3, 1) で３文字目の１文字を取り出しています。違うブック名であれば学年数の位置を Left、 Right、 Mid で指定してください。シート名は「１組」のように数字＋文字または文字＋数字で文字は揃えてください。シート名はブックの中で繰り返し処理をしますのでシート名のクラス数字以外は揃えてください。シート名が決まったら「出席番号を基準に順次処理」の中にある　class = Right(nowWorksheet.Name, 1) でクラス数の位置を指定してください。「Class1」の場合最後がスラス番号なので上のようになります。「１組」なら　class = Left(nowWorksheet.Name, 1) 「１年１組」なら　class = Mid(nowWorksheet.Name, 3, 1) になります。転記集計するブック名を「国語集計.xlsm」としてここにマクロを書き込みます。学年ごとのブックとマクロを含むブック４ファイルを同じフォルダーに入れます。「国語集計」の２行目５列目以降の得点（添付画像の場合100～90）は集計する得点を入力しておきます。100点だけで良ければ100だけ入力しておきます。平均点なので小数点以下が出るので小数点以下を四捨五入しています。マクロは Sub sumUpPoint() 以下を「国語集計」の「ThisWorkbook」に貼り付けます。マクロはできるだけコメントを入れましたのでおわかりになると思います。【注意】１．変数定義のあとにある初期化の消去範囲は書式を変えたときに数値を変更してください。２．マクロ実行時は全ファイルを開いてからマクロを実行してください。ご存知だと思いますがメニュー「開発」ー「マクロ」で「ThisWorkbook.sumUpPoint」を選んで「実行」ボタンです。３．何度も実行しましたがエラーが出るようならその箇所をお知らせください。 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 <> "" ' 学年をブック名から取得する（学年の数字を切り出す） ' 今のケースでは "国語１年.xlsx" なので３文字目１文字 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" なので右の１文字 ' "１組" なら Left(nowWorksheet.Name, 1) となる class = Right(nowWorksheet.Name, 1) point = nowWorksheet.Cells(i, 12) ' 平均点 ' 点数により書き込む列番号c、行番号rを２行目から探す 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

d-q-t-p · Answer

「マクロか関数で」とありますが シートを分けている時点で数式での
解決は諦めたほうがいいでしょう。

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

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

どうしてもマクロもクエリも勉強したくないということなら表の作り方
を見直す（全部１シートにまとめてから抽出する）以外ないと思います。

めくりや · Answer

学年・クラスを項目に追加して、全部の行を１シートにまとめる。
列で並べ替えて手作業で抽出した方が早い。

マクロか関数で処理したいのですが、教えて頂けませんか。

こんばんは ＃４＃５です

No.6です。

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

こんにちは

こんばんは

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

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

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

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

こんばんは　＃４＃５です

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