[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『児童の出欠表の作成 検索 集計表の作成』（エクセル初心者？）
[児童の出欠表の作成と、検索・集計結果表の作成方法]
学校の児童の出欠表を作ろうと思うのですが、
どのようにしたらよろしいでしょうか。お教えください。
今ある表は、次のとおりです。
4/1 4/2 4/3 ・・・ 4/30
朝倉 かぜ かぜ
伊藤 かぜかぜ
内田 けが
・
・
・
渡辺 忌引
表の意味は、
朝倉は、4/1と4/30に「かぜ」で欠席した。
伊藤は、4/2と4/3に「かぜ」で欠席した。
内田は、4/3に「けが」で欠席した。
渡辺は、4/1に「忌引」で欠席した。
と言う意味です。
１番目の質問は、
この表の形式だと、それぞれの学年のシート「１年１組」「１年２組」・・・「６年２組」を用意し、月が変わると別のシートにすることになるので、（横に３６５日分は並べられなかったので）、６学年×２組×１２ヶ月＝１４４枚のシートがいることになりますが、何かシートの枚数を減らす良い工夫はないでしょうか？
ということです。
２番目の質問は、
先の出欠表から次のような2つの表を作りたいのですが、
作り方がわかりませんので、教えてください。
月別・クラス別出欠表（月とクラスを選ぶと以下の表が出てくる）
4月 １年１組 朝倉 4/1 4/30 かぜ かぜ 伊藤 4/2 4/3 かぜ かぜ 内田 4/3 けが 渡辺 4/1 忌引
今日の出欠状況表（日にちを入力すると次の表が出てくる）
４月１日 出欠状況
１年１組 １年２組 ・・・ ６年２組 計
かぜ 1 1
けが 1 2 3
・
・
・
忌引 1
計 2 1 2 4
vlookup関数やそのほかの検索関数、
ピボットテーブルあたりを使うとできそうな気がするのですが、
作り方がわかりません。
大変お手数をおかけしますが、よろしくお願いいたします。
なお、Excel2003,WindowsXPです。
こんにちわ
まず一番目の問題をクリアしませんと、数式でもマクロでも回答しにくい と思います。 そこで、
1.縦と横を逆にする この場合一学年の児童数が256に達するのであれば不可能ですが。
2.各季節休み、土日、祝祭日等、削除して256以内にスリム化する。
等、いずれにしても144枚のシートを操るよりはるかに楽だと思いますが。 (jindon)
参考になるかわかりませんが、私が作るならこうするかな？
まずSheet1のSheet名を『1年1組』の様にクラス名にする。
シートのレイアウトは、
A B C D E
1 月 日付 欠席人数 朝倉 伊藤 ←仮にD1:AA1 に生徒名とする
2 合計 3 1 1
3 4 2004/4/1 1 かぜ
4 4 2004/4/2
A3: =MONTH(B3) で下方向にコピー
B3: 手入力 で下方向に連続データ作成（1年度分）
C2: =SUBTOTAL(2,C$3:C$368) ※行範囲（日付）は変更可
C3: =IF(COUNTA($D3:$AA3),COUNTA($D3:$AA3),"") で下方コピー ※列範囲（生徒数）は変更可
D2: =SUBTOTAL(3,D$3:D$368) で右方向にコピー
該当日（行）の該当生徒（列）に欠席理由を入力。
上記のシートをコピーして各クラス分のシートを作成し、Sheet名を変更する。
※数字の半角全角は、揃えておく（覚えておく）＝あとで必要。
◆月別・クラス別出欠表に関しては、 各クラスのシートにおいて、オートフィルターを使用。 A列で（オプション）− 合計 と等しい OR 4 と等しい ※まとめたい月を選択 C列で（空白以外のセル） →これで代用出来ませんか？ ←大変な事になりそうなので、これで妥協してください。
◆今日の出欠状況表 （別シートを作成） A1: =TODAY() D1: =MATCH(A1,'1年1組'!$B$1:$B$368,FALSE) ※今日が何行目かを探す B2より右方向に各クラス名を入力。（※シート名と同じにする） A3より下方向に理由 B3: =COUNTIF(INDIRECT(B$2&"!B"&$D$1&":Z"&$D$1),$A3) 必要範囲にコピー 計は、SUM関数で入れてください。
いかがでしょう？ 追加質問等に関しては、返答が遅くなるかも知れません。（外出中・考え中） (sin)
一応動いたのですが.... 各シート１行目の日付は半角の「日付」にしてください。 両マクロとも「集計」シートに結果を表示しますのでシートが無い場合は用意してください。 Alt+F11→画面左側「ThisWorkbook」 をダブルクリック→右側空白部分に下記コードをコピー+ペースト 実行は Alt+F8→該当マクロ名選択→実行です。 (jindon)
Sub クラス別()
Dim i As Integer, ii As Integer, iii As Integer, wsT As Worksheet, _
res1 As Variant, res2 As Integer, c1 As Integer, c2 As Integer, Rng1 As Range
Set wsT = Sheets("集計")
On Error Resume Next
Application.ScreenUpdating = False
res1 = InputBox("クラス名を入力" & Chr(10) & Chr(10) & "シート名と同じにして下さい。")
res2 = InputBox("該当月を入力" & Chr(10) & Chr(10) & "半角数字を使用して下さい。")
With wsT
.Activate
.Cells.Clear
.Range("A1").Value = res2 & "月分"
.Range("B1").Value = res1
End With
With Sheets(res1)
For i = 2 To 255
If Month(.Cells(1, i).Value) = res2 Then
c1 = .Cells(1, i).Column
Exit For
End If
Next
For i = 255 To 2 Step -1
If Month(.Cells(1, i).Value) = res2 Then
c2 = .Cells(1, i).Column
Exit For
End If
Next
.Activate
If WorksheetFunction.CountA(Range(Cells(2, c1), Cells(60, c2))) = 0 Then
MsgBox "欠席者はいません"
wsT.Cells.Clear
Set wsT = Nothing
Application.ScreenUpdating = True
Exit Sub
End If
End With
i = 2
Do While Sheets(res1).Cells(i, 1) <> ""
Set Rng1 = Range(Cells(i, c1), Cells(i, c2))
If WorksheetFunction.CountA(Rng1) > 0 Then
wsT.Activate
If wsT.Range("A65536").End(xlUp).Row + 2 = 3 Then
wsT.Cells(Range("A65536").End(xlUp).Row + 1, 1).Value = _
Sheets(res1).Cells(i, 1).Value
Else
wsT.Cells(Range("A65536").End(xlUp).Row + 2, 1).Value = _
Sheets(res1).Cells(i, 1).Value
End If
Sheets(res1).Activate
End If
i = i + 1
Loop
With wsT
For i = 2 To Range("A65536").End(xlUp).Row
If Cells(i, 1).Value <> "" Then
For ii = 2 To Range("A65536").End(xlUp).Row
If Sheets(res1).Cells(ii, 1).Value = .Cells(i, 1).Value Then
For iii = c1 To c2
If Sheets(res1).Cells(ii, iii).Value <> "" Then
.Cells(i, .Range("IV" & i).End(xlToLeft).Column + 1).Value _
= Sheets(res1).Cells(1, iii).Value
.Cells(i, .Range("IV" & i).End(xlToLeft).Column).NumberFormatLocal _
= "d日 aaa"
.Cells(i, .Range("IV" & i).End(xlToLeft).Column).Offset(1, 0).Value _
= Sheets(res1).Cells(ii, iii).Value
End If
Next
End If
Next
End If
Next
ii = .Cells(1, 1).CurrentRegion.Columns.Count + 1
For i = 2 To .Range("A65536").End(xlUp).Row
If .Cells(i, 1).Value <> "" Then
.Cells(i, ii).Offset(1, 0).FormulaR1C1 = _
"=R[-1]C1&""-""&COUNTA(RC1:RC[-1])&""日"""
End If
Next
.Select
.Range("A1").Select
End With
Set wsT = Nothing
Set Rng1 = Nothing
Application.ScreenUpdating = True
End Sub
Sub 日付別()
Dim i As Integer, ii As Integer, ws As Worksheet, wsT As Worksheet, res1 As Date, _
lastA As Integer
Set wsT = Sheets("集計")
On Error Resume Next
Application.ScreenUpdating = False
res1 = InputBox("日付の入力" & Chr(10) & Chr(10) & "例: 2004/12/31")
wsT.Cells.Clear
For Each ws In Sheets
If ws.Name <> wsT.Name Then
ws.Activate
For i = 2 To 256
If ws.Cells(1, i).Value = res1 Then
lastA = Range("A65536").End(xlUp).Row
If WorksheetFunction.CountA(Range(Cells(2, i), Cells(lastA, i))) = 0 Then Exit For
For ii = 2 To lastA
If ws.Cells(ii, i).Value <> "" Then
wsT.Activate
wsT.Cells(Range("B65536").End(xlUp).Row + 1, 2).Value = _
ws.Cells(ii, i).Value
ws.Activate
End If
Next
End If
Next
End If
Next
With wsT
.Activate
If Cells(2, 2).Value = "" Then
MsgBox ("欠席者はいません")
Set wsT = Nothing
Application.ScreenUpdating = True
Exit Sub
End If
.Range("B2:B" & Range("B65536").End(xlUp).Row).Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending
.Range("B2").Copy Destination:=.Range("A2")
For i = 2 To .Range("B65536").End(xlUp).Row
If .Cells(i, 2).Value <> .Cells(Range("A65536").End(xlUp).Row, 1).Value Then
.Cells(Range("A65536").End(xlUp).Row + 1, 1).Value = _
.Cells(i, 2).Value
End If
Next
.Columns(2).Clear
For i = 1 To Sheets.Count
If Sheets(i).Name <> .Name Then
.Cells(1, Range("IV1").End(xlToLeft).Column + 1).Value = _
Sheets(i).Name
End If
Next
With .Cells(1, 1)
.Value = res1
.NumberFormatLocal = "m月d日"
End With
With .Cells(2, 2)
.FormulaR1C1 = _
"=IF(COUNTIF(OFFSET(INDIRECT(R1C&""!""&ADDRESS(2,MATCH(R1C1,INDIRECT(R1C&""!1:1""),0))),,,59,),RC1)=0,""-"",COUNTIF(OFFSET(INDIRECT(R1C&""!""&ADDRESS(2,MATCH(R1C1,INDIRECT(R1C&""!1:1""),0))),,,59,),RC1))"
.Copy
End With
.Range(Cells(2, 2), Cells(Range("A65536").End(xlUp).Row, _
Range("IV1").End(xlToLeft).Column)).PasteSpecial xlFormulas
Application.CutCopyMode = False
.Cells(Range("A65536").End(xlUp).Row + 1, 1).Value = "合計"
With .Cells(Range("A65536").End(xlUp).Row, 2)
.FormulaR1C1 = "=IF(SUM(R2C:R[-1]C)=0,""-"",SUM(R2C:R[-1]C))"
.Copy
End With
.Range(Cells(Range("A65536").End(xlUp).Row, 3), _
Cells(Range("A65536").End(xlUp).Row, _
Range("IV1").End(xlToLeft).Column)).PasteSpecial xlFormulas
Application.CutCopyMode = False
.Columns("A:M").Select
With Selection
.AutoFit
.HorizontalAlignment = xlCenter
End With
End With
Range("A1").Select
Set wsT = Nothing
Application.ScreenUpdating = True
End Sub
sin様の関数を用いた方法と、
jindan様のVBAを用いた方法。
とてもいい勉強になりました。感謝です。
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.