（Ver.3）修学支援新制度のためGPA分布表作成マクロを改変しました。

文科省Q&A更新の影響

高等教育段階の教育費負担新制度に係る質問と回答（Q＆A）：文部科学省

Q101
ＧＰA等の客観的指標が、学部等で下位4分の1との基準について、同順位に複数名がいる場合は、「下位4分の1」にどの範囲まで含まれるのでしょうか。

A101
下位4分の1のライン上に複数の者が並んでいる場合、これらの者は上位4分の3にも属していることになるため、当該者は「下位4分の1」として「警告」の対象となりません。
例えば、12人の課程（下位4分の1は3人）に、上位7番目の者が4人いるような場合には、下位3人目の成績に相当する者が4人いますが、この場合には、当該4人は警告の対象とはせず、下位2人を警告の対象とすることになります。

　修学支援新制度に係るQ&Aが更新され、適格認定に用いるGPA下位25%以下の基準の取り扱いが新たに明記されました。実は、この取り扱いは先日弊BLOGで公表したGPA分布表作成マクロVer2とは異なります。Ver2では下位25%以下の者の人数を累積頻度0.25以下の個数の合計としていました。しかし、文科省の見解では、ライン上に複数名が存在している場合は全員を警告ラインから除外するとしています。これは、下図の通り整理できます。

　これについて、一晩かけて対応を検討し、GPA分布表作成マクロVer.3を作成しました。

GPA分布表作成マクロVer.3

警告ラインの考え方

警告ラインについて、下記表のとおり整理できます。

警告ラインに存在する人数		累積頻度0.25の値の個数
		0個	1個	複数個
累積頻度0.25未満の最大値の個数	1個	累積頻度0.25未満の個数	累積頻度0.25未満の個数	累積頻度0.25未満の個数
	複数個	累積頻度0.25未満の個数-累積頻度0.25未満の最大値の個数	累積頻度0.25未満の個数	累積頻度0.25未満の個数

　文科省の言う「下位4分の1のライン上に複数の者が並んでいる場合」とは、図のとおり、累積頻度0.25の値が存在しない場合に累積頻度0.25未満の最大値が複数ある場合と整理しました。

　これに基づき、警告ラインに存在する人数の算出は以下のとおり整理できます。

• 累積頻度0.25が存在する場合
  • 累積頻度0.25未満の個数
• 累積頻度0.25が存在しない場合
  • 累積頻度0.25未満の最大値が1個存在する場合
    • 累積頻度0.25未満の個数
  • 累積頻度0.25未満の最大値が複数個存在する場合
    • 累積頻度0.25未満の個数から累積頻度0.25未満の最大値の個数を除外

　この条件式をコードに反映させました。

今回の見解に関する所感

　「下位4分の1のライン上に複数の者が並んでいる場合、（略）当該者は「下位4分の1」として「警告」の対象となりません。」とした今回の見解は、基準を緩め少しでも多くの者を救おうとする文科省の意思が感じられるものだと認識しています。

　また、下位4分の1を抽出しようとすると、どのように考えるべきか迷う場面もありました（実際、累積頻度0.25の者の取り扱いはあまり自信がありません）。下手したら訴訟沙汰になるなと感じています。特に境界付近の者の取り扱いや判断には慎重にならなければなりませんね。

機能の追加

　ついでなので、以下の通り、新たに機能を追加しました。

1. 下位４分の１の人数がわかる表を作成（前述）
2. 累積頻度0.25前後の者がわかる表を作成
3. 「本シート以外印刷」機能
4. 「本シート以外印刷（氏名非表示）」機能

※上記図中のGPA及び氏名は乱数により発生された数値及び文字列です。

累積頻度0.25前後の者がわかる表を作成

　実際にGPAを用いて警告者を確認する際には、GPA値だけではなくそれが誰なのかが必要になります。そのため、Sheet1のF列に新たに氏名欄を設け、ヒストグラム作成の際に併せて作成される0.23-0.27の頻度表に氏名を列記するようにしました。

　なお、氏名欄に何も入力しない場合は、0.23-0.27の頻度表に氏名欄は発生しません。

「本シート以外印刷」機能

　同マクロを使用する手順を

1. GPAの入力
2. ヒストグラムの作成
3. 別の学部等のGPAの入力
4. 新たなシートにヒストグラムの作成
5. レポーティング

とした場合、最後のレポーティングにおいて複数のシートを同時に印刷することになります。かつ、その場合には、GPAを入力したSheet1は印刷から除外することが想定されます。そのため、この作業を支援するため、Sheet1に新たに「本シート以外印刷」ボタンを設置しました。

　このボタンを押すと、Sheet1以外のシートを作業グループ化し、印刷ダイアログが立ち上がります。画面遷移を切っているため見た目は作業グループを確認することができませんが、印刷ダイアログでブック全体を選択せずともSheet1以外のシートが指定したプリンターにデータインします。印刷される順序は左から並んでいるシートの順番ですので、必要に応じて、「本シート以外印刷」ボタンを押す前に並び順を変更してください。

　なお、エクセルの仕様上すべてのシートをまとめて両面印刷する処理に手間がかかるため、両面印刷する場合は一旦PDFファイルに出力しそのPDFファイルを両面印刷してください。

「本シート以外印刷（氏名非表示）」機能

　上記の印刷作業において、個人情報のため氏名を非表示にする場合もあると思います。それを想定し、「本シート以下印刷（氏名非表示）」ボタンを設けました。基本的な動作は前述の「本シート以外印刷」と同じですが、シート中の0.23-0.27の頻度表に氏名が列記されていた場合、K列を非表示にし印刷後に再表示するようにしています。これにより、印刷時に氏名欄を削除することができます。

　なお、氏名が列記されたシートとそうではないシートが混在していた場合でも、氏名が列記されたシートのみを選択してK列を非表示にした上で、全体を印刷するようになっています。

ソースコード

Sub HISTOGRAM()



    Dim Target As Variant

    Dim Target2 As Variant

    Dim Target3 As Variant

    Dim Simei As Variant

    Dim Kikan As String

    Dim Gakubu As String

    Dim Nendo As Integer

    Dim Gakunen As Integer

    Dim Gakki As String

    Dim Tmp(1 To 3)

    Dim sh As Object

    Dim shname2 As String

    Dim num, NameLen As Integer

    Dim n As Integer

    Dim m As Integer

    Dim rank() As Double

    Dim i

    Dim j

    

    On Error GoTo Error         ' エラー処理

    

    Application.ScreenUpdating = False

    

    Set Target = Range("E:E")   ' データ範囲を格納

    Set Simei = Range("F:F")    ' データ範囲を格納

    Kikan = Cells(1, 2).Value   ' 機関名を取得

    Gakubu = Cells(2, 2).Value  ' 学部等名を取得

    Nendo = Cells(3, 2).Value   ' 年度を取得

    Gakunen = Cells(4, 2).Value ' 学年を取得

    Gakki = Cells(5, 2).Value   ' 学期を取得

    n = Cells(Rows.Count, "E").End(xlUp).Row    ' E列の最後の行数を取得

    shname = Gakubu & Nendo & "年度第" & Gakunen & "学年" & Gakki   ' シート名を設定

    NameLen = Len(shname)

    num = 2

    

    ReDim rank(n)           ' nを格納

    

    With WorksheetFunction  ' ヒストグラムの要素の幅，最小値，最大値を設定

        Tmp(1) = 0.2        ' ヒストグラムの要素の幅を設定

        Tmp(2) = 0          ' ヒストグラムの要素の最小値値を設定

        Tmp(3) = 4.2        ' ヒストグラムの要素の最大値を設定

        Columns("G:H").Clear

        For i = 1 To n      ' %順位を算出しSheet1に表示

            If Cells(i, 5) <> "" Then

                rank(i) = .PercentRank(Range("E:E"), Cells(i, 5), 5)

                Cells(i, 7).Value = rank(i)

            End If

        Next

        For i = 1 To n

            If Cells(i, 7) < 0.25 Then

                Cells(i, 8).Value = Cells(i, 7).Value

            End If

        Next

    End With

    

    Set Target2 = Range("G:G")              ' sheet1の順位を格納

    Set Target3 = Range("H:H")

    

    Range("G:H").Borders.LineStyle = True   ' %順位に罫線を引く

    

Step1:                                              ' シートを追加する際に同一名称のシートが既にあれば名称の後部にナンバリング

    For Each sh In Worksheets

        If sh.Name = shname Then

            shname = Left(shname, NameLen) & "(" & num & ")"

            num = num + 1

            GoTo Step1

        End If

    Next sh

    

    Sheets.Add.Name = shname    ' シートを追加

    

    ' 度数分布表の作成

    Cells(1, 1).Value = Kikan & " " & Gakubu & " " & Nendo & "年度 第" & Gakunen & "学年" & " " & Gakki

    Cells(2, 1).Value = "▼GPA度数分布表"

    Cells(3, 1).Value = "区間（下境界≦X＜上境界）"

    Cells(3, 3).Value = "度数"

    Cells(3, 4).Value = "最大度数"

    Cells(3, 5).Value = "累積度数"

    Cells(3, 6).Value = "累積頻度"

    Range(Cells(3, 1), Cells(3, 6)).Interior.ColorIndex = 15

    

    With WorksheetFunction      ' 表に数値を入力

        For i = 0 To (Tmp(3) - Tmp(2)) / Tmp(1) - 1

            Cells(i + 4, 1).Value = Tmp(2) + Tmp(1) * i

            Cells(i + 4, 2).Value = Tmp(2) + Tmp(1) * (i + 1)

            Cells(i + 4, 3) = .CountIfs(Target, ">=" & Cells(i + 4, 1).Value, Target, "<" & Cells(i + 4, 2).Value)

            Cells(i + 4, 5) = .Sum(Range(Cells(4, 3), Cells(i + 4, 3)))

            Cells(i + 4, 6) = Cells(i + 4, 5) / .Count(Target)

        Next

        Cells(4, 4).Value = .Max(Range(Cells(4, 3), Cells(i + 4, 3)))

    End With

    

    ' 度数分布表の書式設定

    With Range("A3:B3")

        .Merge

        .HorizontalAlignment = xlCenter

        .ShrinkToFit = True

    End With

    Range("C3:F3").HorizontalAlignment = xlCenter

    Range(Cells(3, 1), Cells(i + 3, 6)).Borders.LineStyle = True

    Range(Cells(3, 1), Cells(i + 3, 2)).Borders(xlInsideVertical).LineStyle = False

    With Range(Cells(4, 1), Cells(i + 3, 1)).HorizontalAlignment = xlRight

    End With

    With Range(Cells(4, 2), Cells(i + 3, 2))

        .NumberFormatLocal = "G/標準"

        .HorizontalAlignment = xlRight

    End With

    ActiveWindow.DisplayGridlines = False

        

    ' グラフ作成

    Range(Cells(3, 3), Cells(i + 3, 4)).Select

    ActiveSheet.Shapes.AddChart(xlColumnClustered).Select ' 集合縦棒グラフを作成

    

    With ActiveChart

        .HasLegend = False                      ' 凡例除去

        .ChartGroups(1).GapWidth = 0            ' 間隔=0

        .HasTitle = True                        ' グラフタイトルあり

        .ChartTitle.Text = Gakubu & " " & Nendo & "年度 第" & Gakunen & "学年" & " " & Gakki & " " & "GPA分布"    ' グラフタイトル

        .ChartTitle.Format.TextFrame2.TextRange.Font.Size = 12  ' グラフタイトルフォントサイズ

    With .SeriesCollection(1)

        .AxisGroup = 2                      ' 柱→2軸

        .Format.Fill.ForeColor.ObjectThemeColor = msoThemeColorAccent3 ' 柱の色→グレー

        .Border.Color = vbWhite             ' 柱の外枠線色→白

        .Border.Weight = xlThin             ' 柱外枠の太さ

    End With

    With .SeriesCollection(2)

        .ChartType = xlXYScatter            ' 最大度数→散布図へ

        .MarkerStyle = xlMarkerStyleNone    ' マーカーを不可視に

    End With

    With .Axes(xlCategory)

        .MinimumScale = Tmp(2)              ' 軸スケール合わせ（最小値）

        .MaximumScale = Tmp(3)              ' 軸スケール合わせ（最大値）

        .MajorUnit = Tmp(1)                 ' 軸スケール合わせ（目盛り）

        .CrossesAt = Tmp(2)                 ' 軸スケール合わせ（交点）

    End With

    With .Axes(xlCategory, xlPrimary)

        .HasTitle = True                    ' x軸タイトルを表示する

        .AxisTitle.Characters.Text = "GPA"  ' x軸タイトル

    End With

    With .Axes(xlValue, xlPrimary)

        .HasTitle = True                    ' y軸タイトルを表示する

        .AxisTitle.Characters.Text = "人数" ' y軸タイトル

    End With

    With .Axes(xlValue, xlSecondary)

        .TickLabelPosition = xlNone         ' 2軸ラベルを不可視に

        .MajorTickMark = xlNone             ' 2軸目盛を不可視に

    End With

        .Parent.Top = Range("M3").Top           ' 位置調整（上端）

        .Parent.Left = Range("M3").Left         ' 位置調整（左端）

    End With

    

    With Worksheets(shname).PageSetup         ' シートを1ページに印刷する設定

        .Orientation = xlLandscape

        .Zoom = False

        .FitToPagesTall = 1

        .FitToPagesWide = 1

    End With

    

    Range("M2").Value = "▼ヒストグラム"        ' ヒストグラム箇所がわかるように表示

    

    ' 累積頻度表の作成

    Cells(3, 8).Value = "累積度数"

    Cells(3, 9).Value = "累積頻度"

    Cells(3, 10).Value = "GPA"

    Cells(3, 11).Value = "氏名"

    Range("H3:K3").HorizontalAlignment = xlCenter

    Range("H3:K3").Interior.ColorIndex = 15

    

    j = 1

    For i = 1 To n

        If Sheets("sheet1").Cells(i, 7).Value <= 0.27 And Sheets("sheet1").Cells(i, 7).Value >= 0.23 Then

            Cells(3 + j, 9).Value = Sheets("sheet1").Cells(i, 7).Value

            Cells(3 + j, 8).Value = WorksheetFunction.CountIf(Target2, "<=" & Cells(3 + j, 9).Value)

            Cells(3 + j, 10).Value = Sheets("sheet1").Cells(i, 5).Value

            Cells(3 + j, 11).Value = Sheets("sheet1").Cells(i, 6).Value

            j = j + 1

            Range(Cells(3, 8), Cells(3 + j - 1, 11)).Borders.LineStyle = True

        End If

    Next i

        

    Range(Cells(3, 8), Cells(3 + j - 1, 11)).Sort Key1:=Range("I4"), Order1:=xlAscending, Header:=xlYes     ' 並び替え

    

    Columns("K").AutoFit     ' K列の幅を自動調整

  

    Range("H2").Value = "▼累積頻度0.23〜0.27"  ' 累積頻度表の箇所がわかるように表示

    

    ' GPA下位25%以下の人数表の作成

    

    Range("M16").Value = "▼GPA下位4分の1に属する人数"       ' GPA下位25%以下の人数表箇所がわかるように表示

    

    With Range("N17:P17")                               ' セルの結合

        .Merge

        .HorizontalAlignment = xlCenter

        .ShrinkToFit = True

    End With

    With Range("N18:P18")                               ' セルの結合

        .Merge

        .HorizontalAlignment = xlCenter

        .ShrinkToFit = True

    End With

    Cells(17, 13).Value = "総数"

    Cells(17, 14).Value = "GPA下位4分の1に属する人数"

    Cells(18, 13).Value = WorksheetFunction.Count(Target)                  ' sheet1GPA欄に入力された数を表示

             

    With WorksheetFunction

        If .CountIf(Target2, 0.25) >= 1 Or .CountIf(Target3, .Max(Target3)) = 1 Then    ' 累積頻度0.25が1つ以上、又は、累積度数0.25未満の最大値が1つ存在する場合

            Cells(18, 14).Value = .CountIf(Target2, "<0.25")    ' 累積頻度0.25以下の合計を表示

        Else                                                        ' その他（累積頻度0.25未満の最大値が複数存在する場合）

            Cells(18, 14).Value = .CountIf(Target2, "<0.25") - .CountIf(Target3, .Max(Target3))    ' 累積頻度0.25未満の数から累積頻度0.25未満の最大値の個数を除く

        End If

    End With

    Range(Cells(17, 13), Cells(18, 16)).HorizontalAlignment = xlCenter     ' セルの中央ぞろえ

    Range(Cells(17, 13), Cells(18, 16)).Borders.LineStyle = True           ' 罫線を引く

    Range("M17:P17").Interior.ColorIndex = 15                              ' 見出しの背景に着色

    

    If WorksheetFunction.CountA(Simei) = 0 Then Columns("K").Delete     ' 氏名欄に入力がない場合はK列を削除

    

    Application.ScreenUpdating = True

    

    Exit Sub

    

Error:      ' エラー処理

    

    If ActiveSheet.Name = shname Then

        Application.DisplayAlerts = False

        ActiveSheet.Delete

        Application.DisplayAlerts = True

    End If

    

    MsgBox "エラーが発生しましたので終了します。エラー内容:" & Err.Description



End Sub



Sub DateClear() ' データ消去



    Range("B2:B5").ClearContents

    Range("E:H").ClearContents



End Sub



Sub SheetDelete()   ' アクティブなシート以外を消去



    Dim sh As Worksheet

    

    With Application

        .DisplayAlerts = False

            For Each sh In Worksheets

                If sh.Name <> ActiveSheet.Name Then

                    sh.Delete

                End If

            Next

        .DisplayAlerts = True

    End With



End Sub



Sub BookPrint()         ' Sheet1以外を印刷



    Dim shno As Long    ' シートの数を定義

    Dim arr() As String ' シートの配列を定義

    Dim n

    Dim i

    

    Application.ScreenUpdating = False

    

    shno = Sheets.Count             ' ブック内のシート数を取得

    If shno = 1 Then Exit Sub       ' シート数が1（Sheet1のみ）だった場合に処理を終了

    ReDim arr(1 To shno - 1)        ' シート数から1を引いた数を配列に格納

    

    n = 1                                   ' シート名がSheet1ではないシートを配列に格納

    For i = 1 To shno

        If Sheets(i).Name <> "Sheet1" Then

            arr(n) = Sheets(i).Name

            n = n + 1

        End If

    Next i

    

    Sheets(arr).Select                          ' シート名がSheet1ではないシートを配列に選択

    

    Application.Dialogs(xlDialogPrint).Show     ' 印刷ダイアログを表示

    

    Sheets("sheet1").Select                     ' 作業グループの選択を解除しSheet1のみを選択

    

    Application.ScreenUpdating = True



End Sub



Sub BookPrintExcName()         ' 氏名を非表示にしてSheet1以外を印刷



    Dim shno As Long    ' シートの数を定義

    Dim arr() As String ' シートの配列を定義

    Dim n

    Dim i

  

    Application.ScreenUpdating = False

            

    shno = Sheets.Count             ' ブック内のシート数を取得

    If shno = 1 Then Exit Sub       ' シート数が1（Sheet1のみ）だった場合に処理を終了

    ReDim arr(1 To shno - 1)        ' シート数から1を引いた数を配列に格納

    

    n = 1                                   ' シート名がSheet1ではないシートを配列に格納

    For i = 1 To shno

        If Sheets(i).Name <> "Sheet1" Then

            arr(n) = Sheets(i).Name

            If Sheets(i).Cells(3, 11).Value = "氏名" Then   ' K3セルが氏名だった場合K列を非表示

                 Sheets(i).Columns("K").Hidden = True

            End If

            n = n + 1

        End If

    Next i

    

    Sheets(arr).Select                          ' シート名がSheet1ではないシートを配列に選択

    

    Application.Dialogs(xlDialogPrint).Show     ' 印刷ダイアログを表示

                                

    For i = 1 To shno

        If Sheets(i).Cells(3, 11).Value = "氏名" Then   ' K3セルが氏名だった場合K列を表示

            Sheets(i).Columns("K").Hidden = False

        End If

    Next i

    

    Sheets("sheet1").Select                     ' 作業グループの選択を解除しSheet1のみを選択

    

    Application.ScreenUpdating = True

        

End Sub

（ファイル公開停止）修学支援新制度のためGPA分布表作成マクロを改変しました。

※文科省のQ&Aに対応していなかったので、ファイルの公開を停止しています。

kakichirashi.hatenadiary.jp

　前回GPA分布表作成マクロを作成したところですが、文科省への事前相談において下位25%以下の人数を分布図中に明記するように指摘された旨の話を耳にしました。この指摘には前回作成したVer1では対応できないため、若干コードを加筆し、下位25%の人数を明記できるようにしたVer2を作成しました。

※GPA下位25％の算出方法が明らかになり当該マクロの算出方法と異なっていたため、公開を中止します。

　ヒストグラムの下に、sheet1E列に入力されたGPAの入力数（全員の人数）と累積頻度0.25以下の数（下位25%以下の人数）を明記するようにしました。使用方法はVer1と同様です。

　なお、私はこの分布表を根拠資料として使用していませんので、実際に申請に使用できるかどうかはわかりません。各機関でご判断願います。

Sub HISTOGRAM()

    

    Dim Target As Range

    Dim Target2 As Range

    Dim Kikan As String

    Dim Gakubu As String

    Dim Nendo As Integer

    Dim Gakunen As Integer

    Dim Gakki As String

    Dim Tmp(1 To 3)

    Dim sh As Object

    Dim shname2 As String

    Dim num, NameLen As Integer

    Dim n As Integer

    Dim rank() As Double

    Dim i

    Dim j

    

    On Error GoTo Error         ' エラー処理



    Application.ScreenUpdating = False

    

    Set Target = Range("E:E")   ' データ範囲を格納

    Kikan = Cells(1, 2).Value   ' 機関名を取得

    Gakubu = Cells(2, 2).Value  ' 学部等名を取得

    Nendo = Cells(3, 2).Value   ' 年度を取得

    Gakunen = Cells(4, 2).Value ' 学年を取得

    Gakki = Cells(5, 2).Value   ' 学期を取得

    n = Cells(Rows.Count, "E").End(xlUp).Row    ' E列の最後の行数を取得

    shname = Gakubu & Nendo & "年度第" & Gakunen & "学年" & Gakki   ' シート名を設定

    NameLen = Len(shname)

    num = 2

        

    ReDim rank(n)           ' nを格納

        

    With WorksheetFunction  ' ヒストグラムの要素の幅，最小値，最大値を設定

        Tmp(1) = 0.2        ' ヒストグラムの要素の幅を設定

        Tmp(2) = 0          ' ヒストグラムの要素の最小値値を設定

        Tmp(3) = 4.2        ' ヒストグラムの要素の最大値を設定

        Columns("F").Clear

        For i = 1 To n      ' %順位を算出しSheet1に表示

            rank(i) = .PercentRank(Range("E:E"), Cells(i, 5), 3)

            Cells(i, 6).Value = rank(i)

        Next

    End With

    

    Set Target2 = Range("F:F")              ' sheet1の順位を格納

    

    Range("F:F").Borders.LineStyle = True   ' %順位に罫線を引く

    

Step1:                                      ' シートを追加する際に同一名称のシートが既にあれば名称の後部にナンバリング

    For Each sh In Worksheets

        If sh.Name = shname Then

            shname = Left(shname, NameLen) & "(" & num & ")"

            num = num + 1

            GoTo Step1

        End If

    Next sh

    

    Sheets.Add.Name = shname    ' シートを追加



    ' 度数分布表の作成

    Cells(1, 1).Value = Kikan & " " & Gakubu & " " & Nendo & "年度 第" & Gakunen & "学年" & " " & Gakki

    Cells(2, 1).Value = "▼GPA度数分布表"

    Cells(3, 1).Value = "区間（下境界≦X＜上境界）"

    Cells(3, 3).Value = "度数"

    Cells(3, 4).Value = "最大度数"

    Cells(3, 5).Value = "累積度数"

    Cells(3, 6).Value = "累積頻度"

    Range(Cells(3, 1), Cells(3, 6)).Interior.ColorIndex = 15

    

    With WorksheetFunction      ' 表に数値を入力

        For i = 0 To (Tmp(3) - Tmp(2)) / Tmp(1) - 1

            Cells(i + 4, 1).Value = Tmp(2) + Tmp(1) * i

            Cells(i + 4, 2).Value = Tmp(2) + Tmp(1) * (i + 1)

            Cells(i + 4, 3) = .CountIfs(Target, ">=" & Cells(i + 4, 1).Value, Target, "<" & Cells(i + 4, 2).Value)

            Cells(i + 4, 5) = .Sum(Range(Cells(4, 3), Cells(i + 4, 3)))

            Cells(i + 4, 6) = Cells(i + 4, 5) / .Count(Target)

        Next

        Cells(4, 4).Value = .Max(Range(Cells(4, 3), Cells(i + 4, 3)))

    End With

    

    ' 度数分布表の書式設定

    With Range("A3:B3")

        .Merge

        .HorizontalAlignment = xlCenter

        .ShrinkToFit = True

    End With

    Range("C3:F3").HorizontalAlignment = xlCenter

    Range(Cells(3, 1), Cells(i + 3, 6)).Borders.LineStyle = True

    Range(Cells(3, 1), Cells(i + 3, 2)).Borders(xlInsideVertical).LineStyle = False

    With Range(Cells(4, 1), Cells(i + 3, 1)).HorizontalAlignment = xlRight

    End With

    With Range(Cells(4, 2), Cells(i + 3, 2))

        .NumberFormatLocal = "G/標準"

        .HorizontalAlignment = xlRight

    End With

    ActiveWindow.DisplayGridlines = False

    



    Range("H2").Value = "▼累積頻度0.23〜0.27"  ' 累積頻度表の箇所がわかるように表示

    ' グラフ作成

    Range(Cells(3, 3), Cells(i + 3, 4)).Select

    ActiveSheet.Shapes.AddChart(xlColumnClustered).Select ' 集合縦棒グラフを作成

        

    With ActiveChart

        .HasLegend = False                      ' 凡例除去

        .ChartGroups(1).GapWidth = 0            ' 間隔=0

        .HasTitle = True                        ' グラフタイトルあり

        .ChartTitle.Text = Gakubu & " " & Nendo & "年度 第" & Gakunen & "学年" & " " & Gakki & " " & "GPA分布"    ' グラフタイトル

        .ChartTitle.Format.TextFrame2.TextRange.Font.Size = 12  ' グラフタイトルフォントサイズ

        With .SeriesCollection(1)

            .AxisGroup = 2                      ' 柱→2軸

            .Format.Fill.ForeColor.ObjectThemeColor = msoThemeColorAccent3 ' 柱の色→グレー

            .Border.Color = vbWhite             ' 柱の外枠線色→白

            .Border.Weight = xlThin             ' 柱外枠の太さ

        End With

        With .SeriesCollection(2)

            .ChartType = xlXYScatter            ' 最大度数→散布図へ

            .MarkerStyle = xlMarkerStyleNone    ' マーカーを不可視に

        End With

        With .Axes(xlCategory)

            .MinimumScale = Tmp(2)              ' 軸スケール合わせ（最小値）

            .MaximumScale = Tmp(3)              ' 軸スケール合わせ（最大値）

            .MajorUnit = Tmp(1)                 ' 軸スケール合わせ（目盛り）

            .CrossesAt = Tmp(2)                 ' 軸スケール合わせ（交点）

        End With

        With .Axes(xlCategory, xlPrimary)

            .HasTitle = True                    ' x軸タイトルを表示する

            .AxisTitle.Characters.Text = "GPA"  ' x軸タイトル

        End With

        With .Axes(xlValue, xlPrimary)

            .HasTitle = True                    ' y軸タイトルを表示する

            .AxisTitle.Characters.Text = "人数" ' y軸タイトル

        End With

        With .Axes(xlValue, xlSecondary)

            .TickLabelPosition = xlNone         ' 2軸ラベルを不可視に

            .MajorTickMark = xlNone             ' 2軸目盛を不可視に

        End With

        .Parent.Top = Range("K3").Top           ' 位置調整（上端）

        .Parent.Left = Range("K3").Left         ' 位置調整（左端）

    End With

    

      With Worksheets(shname).PageSetup         ' シートを1ページに印刷する設定

        .Orientation = xlLandscape

        .Zoom = False

        .FitToPagesTall = 1

        .FitToPagesWide = 1

    End With

    

    Range("K2").Value = "▼ヒストグラム"        ' ヒストグラム箇所がわかるように表示

    

    ' 累積頻度表の作成

    Cells(3, 8).Value = "累積頻度"

    Cells(3, 9).Value = "GPA"

    Range("H3:I3").HorizontalAlignment = xlCenter

    Range("H3:I3").Interior.ColorIndex = 15

    j = 1

    For i = 1 To n

            If Sheets("sheet1").Cells(i, 6).Value <= 0.27 And Sheets("sheet1").Cells(i, 6).Value >= 0.23 Then

               Cells(3 + j, 8).Value = Sheets("sheet1").Cells(i, 6).Value

               Cells(3 + j, 9).Value = Sheets("sheet1").Cells(i, 5).Value

               j = j + 1

               Range(Cells(3, 8), Cells(3 + j - 1, 9)).Borders.LineStyle = True

            End If

    Next i

        

    Range(Cells(3, 8), Cells(3 + j - 1, 9)).Sort Key1:=Range("H4"), Order1:=xlAscending, Header:=xlYes

    

    ' GPA下位25%以下の人数表の作成

    Range("K16").Value = "▼GPA下位25%以下の人数"       ' GPA下位25%以下の人数表箇所がわかるように表示

    

    With Range("L17:N17")                               ' セルの結合

        .Merge

        .HorizontalAlignment = xlCenter

        .ShrinkToFit = True

    End With

    With Range("L18:N18")                               ' セルの結合

        .Merge

        .HorizontalAlignment = xlCenter

        .ShrinkToFit = True

    End With

     Cells(17, 11).Value = "総数"

     Cells(17, 12).Value = "GPA下位25%以下の人数"

     Cells(18, 11).Value = WorksheetFunction.Count(Target)                  ' sheet1GPA欄に入力された数を表示

     Cells(18, 12).Value = WorksheetFunction.CountIf(Target2, "<= 0.25")    ' sheet1順位欄の0.25以下の数を表示

     Range(Cells(17, 11), Cells(18, 14)).HorizontalAlignment = xlCenter     ' セルの中央ぞろえ

     Range(Cells(17, 11), Cells(18, 14)).Borders.LineStyle = True           ' 罫線を引く

     Range("K17:N17").Interior.ColorIndex = 15                              ' 見出しの背景に着色

     

     Application.ScreenUpdating = True



    Exit Sub

    

Error:  ' エラー処理

   

   If ActiveSheet.Name = shname Then

        Application.DisplayAlerts = False

        ActiveSheet.Delete

        Application.DisplayAlerts = True

    End If

    

   MsgBox "エラーが発生しましたので終了します。エラー内容:" & Err.Description



End Sub



Sub DateClear() ' データ消去

    

    Range("B2:B5").ClearContents

    Range("E:F").ClearContents



End Sub



Sub SheetDelete()   ' アクティブなシート以外を消去



    Dim sh As Worksheet

    

    With Application

        .DisplayAlerts = False

        For Each sh In Worksheets

            If sh.Name <> ActiveSheet.Name Then

            sh.Delete

            End If

        Next

        .DisplayAlerts = True

    End With



End Sub

修学支援新制度のためGPA分布表作成マクロを作成しました。

　修学支援新制度では、申請時にGPA分布状況がわかる資料の提出が求められるとともに、継続時（適格認定時）においてもGPA下位25%にある支援者に対して警告措置を行わなければなりません。そのため、機関としてGPA分布状況を把握することが重要になります。その一助とするため、GPA分布表を自動生成するマクロファイルを作成しました。

GPA分布表作成マクロ

　片手間に作成したので、CellsとRangeの使い分けなどしっかりとしたものではありません。なお、作成に当たっては、「静粛に、只今統計勉強中」さんのソースコードをベースにさせていただきました。ありがとうございます。また、内容の正確性は保証するのではなく、使用は自己責任でお願いします。動作確認はWin10Ofiice2017で行っています。

　ファイルは、sheet1というワークシートで構成されています。黄色で着色された箇所がユーザーの入力箇所です。

　まずは、sheet1のB1-B5セルに機関名、学部等名、年度、学年、学期を入力します。年度及び学年は自然数を入力してください。ここに入力された機関名等が、分布表生成ワークシートの名前やヒストグラムのタイトルに反映されます。

　次に、sheet1のE列にGPAを入力します。テキスト形式で縦に並べて入力（実際には恐らくコピペ）してください。昇順降順に並べる必要はなく、空欄があっても対応しています。

　sheet1には、以下の３つのマクロボタンが設定されています。

1. ヒストグラム作成
2. データ消去
3. 本シート以外削除

　１は、新たなシートを作成し、入力されたデータを元に度数分布表やヒストグラムを表示します。新たなシートの名前はB2-B5セルに入力された学部等名、年度、学年、学期が反映されますが、同じ名前のシートが既に存在していても名前の後ろにナンバリングし新たなシートを作成します。

　２は、B1以外の黄色セルのデータを消去します。例えば、A学部のGPA分布を作成した後、B1以外のデータを削除し、B学部のデータを入力してB学部のGPA分布を作成することなどを想定しています。こうすれば、１つのブックで複数の学部のGPA分布をシートごとに表示できます。

　３は、sheet1以外のシートを削除します。テスト段階で１ボタンを押したくさんのシートを作成しまとめて削除していたので、その名残です。

　１ボタンにより作成された新たなシートには、度数分布表と累積度数0.23-0.27のGPA、ヒストグラムが表示されます。前述の通り、赤枠のシート名、グラフ名はsheet1の学部等名などを反映させています。なお、画像のGPAは0.0から4.0の間で発生させた100個の乱数の度数分布結果であり、実際のGPAではありません。

　作成された新たなシートは、初期設定でA４横一枚に収めて印刷できるようにしてあるので、マクロボタン押下→シート印刷という最短でのレポーティングが可能です。（本当はヒストグラムの中に下位25%の線分を発生させたかったのですが私の技術ではできませんでした。。。）

　また、GPAは基本的には0.0−4.0の間の値を取るため、度数分布表は最小値0最大値4幅0.2で設定しています（最初はスタージェスの公式により階級数を算出していましたが煩雑になるため固定値としました）。ただ、最大値4では最後の階級が3.8以上4未満となりGPA4.0の者が反映されないため、最後の階級は4.0以上4.2未満としました。

　適格認定では、GPA分布下位25%の者に対し警告を与えることになっています。そのため、累積度数0.23から0.27のGPAを抽出し、表示しています。母数が少ないと0.23から0.27の間にGPAが表示されない可能性がありますが、その場合はVisualBasicを開きプログラムの157行目の数値を訂正してください。なお、プログラムを若干書き換えれば累積度数0.23から0.27のGPAの隣に氏名を表示させることも可能です。

　平成30年度学校基本調査によれば、各学校種の設置数は大学782校、短大331校、高専57校、専門課程を持つ専修学校2,805校であり、合計3,975機関です。全ての機関が申請するとして、1機関に1人が1時間をかけてGPA分布資料を作成し担当者の時給を2000円程度と仮定すると、総じて7,950,000円分程度は貢献できたでしょうか。これで少しでも担当者の労力が緩和できればいいな、と思っています。

Sub HISTOGRAM()

    

    Dim Target As Range

    Dim Kikan As String

    Dim Gakubu As String

    Dim Nendo As Integer

    Dim Gakunen As Integer

    Dim Gakki As String

    Dim Tmp(1 To 3)

    Dim sh As Object

    Dim shname2 As String

    Dim num, NameLen As Integer

    Dim n As Integer

    Dim rank() As Double

    Dim i

    Dim j

    

    On Error GoTo Error



    Application.ScreenUpdating = False

    

    Set Target = Range("E:E")   ' データ範囲を格納

    Kikan = Cells(1, 2).Value   ' 機関名を取得

    Gakubu = Cells(2, 2).Value  ' 学部等名を取得

    Nendo = Cells(3, 2).Value   ' 年度を取得

    Gakunen = Cells(4, 2).Value ' 学年を取得

    Gakki = Cells(5, 2).Value   ' 楽器を取得

    n = Cells(Rows.Count, "E").End(xlUp).Row    ' E列の最後の行数を取得

    shname = Gakubu & Nendo & "年度第" & Gakunen & "学年" & Gakki   ' シート名を設定

    NameLen = Len(shname)

    num = 2

        

    ReDim rank(n)

        

    With WorksheetFunction  ' ヒストグラムの要素の幅，最小値，最大値を設定

        Tmp(1) = 0.2

        Tmp(2) = 0

        Tmp(3) = 4.2

        Columns("F").Clear

        For i = 1 To n      ' %順位を算出しSheet1に表示

            rank(i) = .PercentRank(Range("E:E"), Cells(i, 5), 3)

            Cells(i, 6).Value = rank(i)

        Next

    End With

    

    Range("F:F").Borders.LineStyle = True   ' %順位に罫線を引く

    

Step1:                                      ' シートを追加する際に同一名称のシートが既にあれば名称の後部にナンバリング

    For Each sh In Worksheets

        If sh.Name = shname Then

            shname = Left(shname, NameLen) & "(" & num & ")"

            num = num + 1

            GoTo Step1

        End If

    Next sh

    

    Sheets.Add.Name = shname    ' シートを追加



    ' 度数分布表の作成

    Cells(1, 1).Value = Kikan & " " & Gakubu & " " & Nendo & "年度 第" & Gakunen & "学年" & " " & Gakki

    Cells(2, 1).Value = "▼GPA度数分布表"

    Cells(3, 1).Value = "区間（下境界≦X＜上境界）"

    Cells(3, 3).Value = "度数"

    Cells(3, 4).Value = "最大度数"

    Cells(3, 5).Value = "累積度数"

    Cells(3, 6).Value = "累積頻度"

    Range(Cells(3, 1), Cells(3, 6)).Interior.ColorIndex = 15

    

    With WorksheetFunction      ' 表に数値を入力

        For i = 0 To (Tmp(3) - Tmp(2)) / Tmp(1) - 1

            Cells(i + 4, 1).Value = Tmp(2) + Tmp(1) * i

            Cells(i + 4, 2).Value = Tmp(2) + Tmp(1) * (i + 1)

            Cells(i + 4, 3) = .CountIfs(Target, ">=" & Cells(i + 4, 1).Value, Target, "<" & Cells(i + 4, 2).Value)

            Cells(i + 4, 5) = .Sum(Range(Cells(4, 3), Cells(i + 4, 3)))

            Cells(i + 4, 6) = Cells(i + 4, 5) / .Count(Target)

        Next

        Cells(4, 4).Value = .Max(Range(Cells(4, 3), Cells(i + 4, 3)))

    End With

    

    ' 度数分布表の書式設定

    With Range("A3:B3")

        .Merge

        .HorizontalAlignment = xlCenter

        .ShrinkToFit = True

    End With

    Range("C3:F3").HorizontalAlignment = xlCenter

    Range(Cells(3, 1), Cells(i + 3, 6)).Borders.LineStyle = True

    Range(Cells(3, 1), Cells(i + 3, 2)).Borders(xlInsideVertical).LineStyle = False

    With Range(Cells(4, 1), Cells(i + 3, 1)).HorizontalAlignment = xlRight

    End With

    With Range(Cells(4, 2), Cells(i + 3, 2))

        .NumberFormatLocal = "G/標準"

        .HorizontalAlignment = xlRight

    End With

    ActiveWindow.DisplayGridlines = False

    



    Range("H2").Value = "▼累積頻度0.23〜0.27"  ' 累積頻度表の箇所がわかるように表示

    ' グラフ作成

    Range(Cells(3, 3), Cells(i + 3, 4)).Select

    ActiveSheet.Shapes.AddChart(xlColumnClustered).Select ' 集合縦棒グラフを作成

        

    With ActiveChart

        .HasLegend = False                      ' 凡例除去

        .ChartGroups(1).GapWidth = 0            ' 間隔=0

        .HasTitle = True                        ' グラフタイトルあり

        .ChartTitle.Text = Gakubu & " " & Nendo & "年度 第" & Gakunen & "学年" & " " & Gakki & " " & "GPA分布"    ' グラフタイトル

        .ChartTitle.Format.TextFrame2.TextRange.Font.Size = 12  ' グラフタイトルフォントサイズ

        With .SeriesCollection(1)

            .AxisGroup = 2                      ' 柱→2軸

            .Format.Fill.ForeColor.ObjectThemeColor = msoThemeColorAccent3 ' 柱の色→グレー

            .Border.Color = vbWhite             ' 柱の外枠線色→白

            .Border.Weight = xlThin             ' 柱外枠の太さ

        End With

        With .SeriesCollection(2)

            .ChartType = xlXYScatter            ' 最大度数→散布図へ

            .MarkerStyle = xlMarkerStyleNone    ' マーカーを不可視に

        End With

        With .Axes(xlCategory)

            .MinimumScale = Tmp(2)              ' 軸スケール合わせ（最小値）

            .MaximumScale = Tmp(3)              ' 軸スケール合わせ（最大値）

            .MajorUnit = Tmp(1)                 ' 軸スケール合わせ（目盛り）

            .CrossesAt = Tmp(2)                 ' 軸スケール合わせ（交点）

        End With

        With .Axes(xlCategory, xlPrimary)

            .HasTitle = True                    ' x軸タイトルを表示する

            .AxisTitle.Characters.Text = "GPA"  ' x軸タイトル

        End With

        With .Axes(xlValue, xlPrimary)

            .HasTitle = True                    ' y軸タイトルを表示する

            .AxisTitle.Characters.Text = "人数" ' y軸タイトル

        End With

        With .Axes(xlValue, xlSecondary)

            .TickLabelPosition = xlNone         ' 2軸ラベルを不可視に

            .MajorTickMark = xlNone             ' 2軸目盛を不可視に

        End With

        .Parent.Top = Range("K3").Top           ' 位置調整（上端）

        .Parent.Left = Range("K3").Left         ' 位置調整（左端）

    End With

    

      With Worksheets(shname).PageSetup         ' シートを1ページに印刷する設定

        .Orientation = xlLandscape

        .Zoom = False

        .FitToPagesTall = 1

        .FitToPagesWide = 1

    End With

    

    Range("K2").Value = "▼ヒストグラム"        ' ヒストグラム箇所がわかるように表示

    

    ' 累積頻度表の作成

    Cells(3, 8).Value = "累積頻度"

    Cells(3, 9).Value = "GPA"

    Range("H3:I3").HorizontalAlignment = xlCenter

    Range("H3:I3").Interior.ColorIndex = 15

    j = 1

    For i = 1 To n

            If Sheets("sheet1").Cells(i, 6).Value <= 0.27 And Sheets("sheet1").Cells(i, 6).Value >= 0.23 Then

               Cells(3 + j, 8).Value = Sheets("sheet1").Cells(i, 6).Value

               Cells(3 + j, 9).Value = Sheets("sheet1").Cells(i, 5).Value

               j = j + 1

               Range(Cells(3, 8), Cells(3 + j - 1, 9)).Borders.LineStyle = True

            End If

    Next i

        

    Range(Cells(3, 8), Cells(3 + j - 1, 9)).Sort Key1:=Range("H4"), Order1:=xlAscending, Header:=xlYes

    

    Application.ScreenUpdating = True



    Exit Sub

    

Error:  ' エラー処理

   

   If ActiveSheet.Name = shname Then

   

        Application.DisplayAlerts = False

        ActiveSheet.Delete

        Application.DisplayAlerts = True

    End If

    

   MsgBox "エラーが発生しましたので終了します。エラー内容:" & Err.Description



End Sub



Sub DateClear() ' データ消去

    

    Range("B2:B5").ClearContents

    Range("E:F").ClearContents



End Sub



Sub SheetDelete()   ' アクティブなシート以外を消去



    Dim sh As Worksheet

    

    With Application

        .DisplayAlerts = False

        For Each sh In Worksheets

            If sh.Name <> ActiveSheet.Name Then

            sh.Delete

            End If

        Next

        .DisplayAlerts = True

    End With



End Sub

修学支援新制度で注意したい３点

　修学支援新制度は、そろそろ事前相談が行われている頃でしょうか。修学支援新制度においては、現時点で、以下の３点を注意したいと考えています。

１．授業料減免のスケジュール等

　授業料減免は大学等側が対応することになっています。JASSOが行う学資給付金の認定に合わせて対応すれば良いと思うのですが、スケジュールや申請様式等については大学等側で策定しなければなりません。説明会では、文科省から統一スケジュール等が示されるかもしれないとの話でしたので、それも待ちつつ考えていきたいですね。

２．GPAの算出方法

　申請書ではGPAの分布状況に係る資料を提出することになっており、それは原則として1年生の分布であることがすでにQ&Aに示されています。それは良いのですが、継続の判断（適格認定）をする際にもGPAが用いられます。具体的には、GPAが下位25％以下であれば、警告を行うことになります。

　適格認定に係るGPAの算出については、どの範囲でどのように行うのか（学年ごとなのか、前後学期なのか通年なのか、標準修業年限が異なる学科はどうするのか）が、いまいち判然としません。こちらも、説明会にて文科省からGPAの算出方法について通知があるような話がありましたので、それを待ちつつGPA分布を確認できる方法や時期を検討することになるでしょう。

３．既存の支援制度との関係

　新制度と既存の支援制度を比較し、該当しなくなる者への対応をどうするかはシビアな問題だと認識しています。

　特に、国立大学では、旧来の一般運営費交付金の特殊要因経費について授業料全額半額免除の予算が計上されてきました。

＜2019年度文部科学関係予算（案）主要事項＞

　この予算がどのようになるのかも含めて、検討が必要だと考えています。

修学支援新制度における学生等の確認要件を整理する。

　前回、前々回に引き続き、修学支援支援新制度について整理します。今回は、支援措置の対象となる学生等の認定要件（以下、「支援認定要件」という。）についてです。

１．根拠法 

大学等における修学の支援に関する法律　抄

第三条　大学等における修学の支援は、確認大学等に在学する学生等のうち、特に優れた者であって経済的理由により極めて修学に困難があるものに対して行う学資支給及び授業料等減免とする。

第八条　確認大学等の設置者は、当該確認大学等に在学する学生等のうち、文部科学省令で定める基準及び方法に従い、特に優れた者であって経済的理由により極めて修学に困難があるものと認められるものを授業料等減免対象者として認定し、当該授業料等減免対象者に対して授業料等の減免を行うものとする。

第十二条　確認大学等の設置者は、文部科学省令で定めるところにより、当該確認大学等に在学する授業料等減免対象者が偽りその他不正の手段により授業料等減免を受けた又は次の各号のいずれかに該当するに至ったと認めるときは、当該授業料等減免対象者に係る第八条第一項の規定による認定（以下この条において単に「認定」という。）を取り消すことができる。

1. 学業成績が著しく不良となったと認められるとき。
2. 学生等たるにふさわしくない行為があったと認められるとき。

２　確認大学等の設置者は、前項の規定により認定を取り消したときは、文部科学省令で定めるところにより、その旨を当該確認大学等に係る確認をした文部科学大臣等に届け出なければならない。

３　第一項の規定により認定を取り消した確認大学等の設置者に対し減免費用を支弁する国等は、前項の規定による届出があった場合において、当該認定を取り消された学生等に対する授業料等減免に係る減免費用を既に支弁しているときは、国税徴収の例により、当該確認大学等の設置者から当該減免費用に相当する金額を徴収することができる。

４　前項の規定による徴収金の先取特権の順位は、国税及び地方税に次ぐものとする。

独立行政法人日本学生支援機構法　抄

第十七条の二　第十三条第一項第一号に規定する学資として支給する資金（以下「学資支給金」という。）は、大学等における修学の支援に関する法律（令和元年法律第八号）第二条第三項に規定する確認大学等（以下この項において「確認大学等」という。）に在学する優れた学生等であって経済的理由により修学に困難があるもののうち、文部科学省令で定める基準及び方法に従い、特に優れた者であって経済的理由により極めて修学に困難があるもののと認定された者（同法第十五条第一項の規定による同法第七条第一項の確認の取消し又は確認大学等の設置者による当該確認大学等に係る同項の確認の辞退の際、当該確認大学等に在学している当該認定された者を含む。）に対して支給するものとする。

第十七条の三　機構は、学資支給金の支給を受けた者が次の各号のいずれかに該当するに至ったときは、文部科学省令で定めるところにより、その者から、その支給を受けた学資支給金の額に相当する金額の全部又は一部を返還させることができる。

1. 学業成績が著しく不良となったと認められるとき。
2. 学生等たるにふさわしくない行為があったと認められるとき。

　なお、政省令の案は公表されていません。

２．概要

１．採用時の支援認定要件 

　説明会資料により、支援認定要件は以下のとおりです。

　大きく整理すると、以下の4点ですね。

1. 家計の経済状況に関する要件
2. 学業成績・学修意欲に関する要件
3. 国籍・在留資格に関する要件
4. 大学等に進学するまでの期間に関する要件

　この際の手続きについて、説明会資料に大まかに記載されています。

（４）支援措置の対象となる学生等の認定に関する手続（別紙３参照）

○ 支援措置を受けようとする者は、学資支給（給付型奨学金の支給）については独立行政法人日本学生支援機構（以下「機構」という。）に、授業料等減免については（２）の確認を受けた大学等（以下「確認大学等」という。）に対し、それぞれ申込を行うことについて定める。

○ 学生等からの申込を受けて、学資支給については機構が、授業料等減免については確認大学等が、（１）の認定要件に基づき選考を行うことについて定める。

○ 機構及び確認大学等は、（１）の認定要件に基づく選考の結果を学生等に通知することについて定める。

○ 学資支給の対象者として機構の認定を受けた学生等については、授業料等減免の対象者として認定を受けることができる者とみなすことを定める。

２．継続時の支援認定要件（適格認定の基準）

　ここまでの要件は、学資支給金や授業料等減免に係る”採用時の”要件です。これとは別に、採用後に支援を継続するための”継続時の”要件も存在します。継続時の審査のことを「適格認定」と言い、継続時の要件を満たしていなければ、学生は支援を打ち切られてしまいます。説明会資料により、継続時の試験認定要件や手続きは、以下のとおりです。

　継続時（適格認定）の手続きも、説明会資料に大まかに記載されています。

（６）支援措置の実施に関する手続等（別紙６参照）

○ 支援対象者は、各学年において継続して支援措置を受けようとするときは、学資支給については毎年一回、授業料減免については毎年二回、それぞれ申込を行うことについて定めるとともに、申込を行わない場合は支援措置を打ち切る（支援対象者の認定を取り消す）ことについて定める。

○ 機構及び確認大学等は、毎年一回、支援措置の対象者が学業成績・学修意欲（以下「学業成績等」という。）に関する基準及び収入・資産額に関する基準に適合するかどうかの判定（以下「適格認定」という。）を行う（高等専門学校及び修業年限が二年以下の確認大学等は、学業成績等に関する適格認定を毎年二回行う）ことについて定める。

○ 収入・資産額に関する適格認定において、機構がその基準に適合することの判定を行った学生等については、確認大学等がその基準に適合することの判定を行った者とみなすことについて定める。

○ 機構及び確認大学等は、適格認定の判定の結果、支援措置を見直す必要があるときは、毎年四月又は十月に、支援措置の廃止、停止又は額の変更を行うことについて定める。

○ 機構及び確認大学等は、適格認定の結果、支援対象者の学業成績・学修意欲がその基準に照らして警告区分に該当するときは、その支援対象者に学業成績等が不振である旨の警告を行うことについて定める。

○ 偽りその他不正の手段により支援措置を受けた場合、確認大学等から退学・無期又は三か月以上の停学の懲戒処分を受けた場合等における支援措置の打ち切りについて定める。

○ 確認大学等から休学を認められた場合、三か月未満の停学の懲戒処分を受けた場合等においては支援措置を停止することとし、復学時に（１）の認定要件を満たす場合、学生等からの申込に基づき、支援措置を再開することについて定める。

○ 機構及び確認大学等は、支援措置の打ち切り又は額の変更を行うときは、あらかじめ、その支援対象者に通知することについて定める。

○ 確認大学等は、学業成績・学修意欲に関する適格認定の判定の結果を機構に通知するとともに、支援対象者に対する懲戒処分、休学の認定等について機構に通知することについて定める。

○ 確認大学等の設置者は、授業料等減免の対象者の認定を取り消したときは、遅滞なく、取消しの年月日、人数、減免の額等を（２）の確認をした文部科学大臣等に届け出なければならないことについて定める。

○ 機構法第十三条第一項第一号の業務の実施に当たり、その対象となる学生等及びその生計を維持する者のマイナンバー（行政手続における特定の個人を識別するための番号の利用等に関する法律第二条第五項に規定する個人番号をいう。）の提出を求めることについて定める。

３．支援要件確認の整理

　前述のとおり、学資支給金（給付型奨学金）はJASSOが、授業料等減免は確認大学等が要件確認を行うこととされています。これは、学資支給金（給付型奨学金）と授業料等減免とがワンセットの制度であると言いながらも、それぞれが別の法律により定められているためでしょう。以下のとおり、想定される支援要件確認の主体について、整理しました。                                                                                           

		学資支給金	授業料等減免	備考
採用時	家計の経済状況	JASSOが確認	確認大学等がJASSOの結果を反映
	学力・学修意欲	JASSOが確認	確認大学等がJASSOの結果を反映？
継続時（適格認定）	家計の経済状況	JASSOが確認	確認大学等がJASSOの結果を反映	夏頃確認→10月反映
	学力・学修意欲	JASSOが確認大学等の結果を反映？	確認大学等が確認	学年末確認→翌学年当初繁栄 ※高専・2年制学校は年2回（夏頃及び学年末に確認）

　JASSOが行う経済状況の判定結果により確認大学等の判定とみなすことができるため、経済状況の判定はJASSOの結果にゆだねることになるでしょう。また、採用時の学力判定についても、高校3年生時の状況ですので、JASSOの判定（生徒が在籍する高等学校の判定？）に委ねることになるのかなと思っています。一方、確認大学等においては、在学中の適格認定における学力の判定は必ず行うことになります。高専や2年制の学校（短大など）は、年2回学力判定を行わなければならないため、すこし大変かもしれません。

　本件については、Q&Aにも記載があります。

Ｑ 所得や資産に関する要件の確認は、誰が行うのでしょうか。

Ａ 給付型奨学金の申込者が、所得の要件を満たしているのか、申込者から提出されたマイナンバーを活用してJASSOが市町村民税の課税状況などの情報を確認しますので、申込者本人とその生計維持者（原則、父母）のマイナンバー関係書類をJASSOに送付する必要があります。資産についても、JASSOに申告する必要があります。
給付型奨学金と授業料等減免を受けるための要件は同一ですので、授業料等減免の申込者については、給付型奨学金の対象者として認定されていることをもって、授業料減免の対象者の認定を受けられますので、大学等において重ねて所得や資産を確認することは不要とする制度になる予定です。給付型奨学金の支援区分等の情報は、本人の同意のもと、JASSOのシステムを通じて授業料等減免を実施する大学等と連携する予定です。

Ｑ 授業料等減免の申込みにおいて、大学等の入学時に改めて高校等の成績や学修意欲の確認が行われるのでしょうか。

Ａ 授業料等減免の申込者については、給付型奨学金の対象として認定されていることをもって、授業料等減免の対象者の認定を受けられますので、大学等において重ねて同じ要件に関することを確認する必要はありません。 

４．スケジュールの推測

　個人支援の申請スケジュールについて、説明資料では以下の通り記載があります。

　ざっくりと下図のとおり整理しました。

　これを作成している際にどうなるかわからないなと思ったことが、確認大学等が行う授業料等減免の申請スケジュールです（上図の授業料等減免スケジュールはおそらく誤っています）。本件について、Q&Aには以下の通り記載があります。

Ｑ 授業料や入学金の減免に関する申込手続（スケジュールや方法）について教えてください。

Ａ 2020年度に進学予定の方は、各大学等が定める手続きに従って、進学時に各大学等で申込みを行っていただくことになります。（給付型奨学金の予約採用の申込手続は、本年6月頃から開始されます。詳しくは、給付型奨学金に関するQ&Aを参照。）

現時点で既に、大学等に在学されている方についても、2020年度から支援を受けるためには、在学している大学等に申込みを行うことになります。本年（2019年）の秋以降、減免に関する最初の申込みの手続が始まる見込みです。（給付型奨学金の手続も本年秋以降に始まる見込みです。）

申込後、各大学等で審査が行われ、結果が出たら速やかに本人に対して通知されることになります。学業成績等や家計状況の要件は給付型奨学金と同じですので、給付型奨学金（新制度）の対象となる方は、授業料等減免の対象にもなります。（給付型奨学金の対象となった方の支援区分の情報は、本人同意のもと、JASSOを通じて各大学等に情報連携する仕組みとなる予定です）。

減免の対象者として認定を受けた後は、毎年（ただし２年制以下の大学等については、毎年２回）、支援継続に関する手続を行う必要があります。 

　授業料等減免の申請は確認大学等が担当するとなっており、統一スケジュールや様式は現時点で公表されていません。特に近年では、定員充足100%を目指し各大学等が補欠合格等を繰り返し、最終的に入学する大学等が確定することが非常に遅くなっている印象があります。どのようなスケジュールを組むかは悩ましい問題と感じています。

　ここまで記載したのは予約申請など代表的なかつ大まかな整理にとどまっており、在学申請や高認試験を経た申請など、若干条件が異なる対応が多く存在します。このあたりも留意していきたいところです。

　3回にわたり、修学支援新制度の整理を行ってきました。言及できなかったことも多々あるので、引き続き文部科学省からの通知等を注視しつつ、学んでいきたいと思っています。

学生対応のリスクは常に存在している。

nikkan-spa.jp

そんな中、今年5月、（自称）“ミスター中央大学”として活躍していたYouTuber・ステハゲが、中央大学当局から動画での言動が問題視され、結果として謝罪動画を投稿一部の動画を削除・修正するという事件が起きた。

　今、Youtuberと大学側との関係が話題になっています。一通り動画を流し見たのですが、途中、職員が対応しているところを明らかに隠し撮り（録音）しているところがあり、これはキッツイよなーと思ってしまいました。

　ガジェットやSNSが発達し、職員が行った学生対応を録音録画し拡散することが容易になっています。学生対応する職員は常にそのリスクを意識し、誠実かつ合理的に職務にあたらなければならないと気を新たにしました。

　なお、私は学生と教員と職員がともに大学の構成員であると思っていますので、教員に対して行わないこと（態度や説明など）は学生に対しても行わないようにしています。

修学支援新制度の機関確認要件を整理する。

kakichirashi.hatenadiary.jp

　前回に引き続き、修学支援新制度について整理します。今回は、特に機関確認要件に言及します。

１．根拠法

大学等における修学の支援に関する法律　抄

第七条　次の各号に掲げる大学等の設置者は、授業料等減免を行おうとするときは、文部科学省令で定めるところにより、当該各号に定める者（以下「文部科学大臣等」という。）に対し、当該大学等が次項各号に掲げる要件を満たしていることについて確認を求めることができる。

1. 大学及び高等専門学校（いずれも学校教育法第二条第二項に規定する国立学校又は私立学校であるものに限る。第十条第一号において同じ。）並びに国立大学法人（国立大学法人法（平成十五年法律第百十二号）第二条第一項に規定する国立大学法人をいう。第十条第一号において同じ。）が設置する専門学校　文部科学大臣
2. 国が設置する専門学校当　該専門学校が属する国の行政機関の長
3. 独立行政法人（独立行政法人通則法（平成十一年法律第百三号）第二条第一項に規定する独立行政法人をいう。以下この号及び第十条第一号において同じ。）が設置する専門学校　当該独立行政法人の主務大臣（同法第六十八条に規定する主務大臣をいう。）
4. 地方公共団体が設置する大学等　当該地方公共団体の長
5. 公立大学法人（地方独立行政法人法（平成十五年法律第百十八号）第六十八条第一項に規定する公立大学法人をいう。以下この項及び第十条第三号において同じ。）が設置する大学等　当該公立大学法人を設立する地方公共団体の長
6. 地方独立行政法人（地方独立行政法人法第二条第一項に規定する地方独立行政法人をいい、公立大学法人を除く。以下この号及び第十条第四号において同じ。）が設置する専門学校　当該地方独立行政法人を設立する地方公共団体の長
7. 専門学校（前各号に掲げるものを除く。） 　当該専門学校を所管する都道府県知事

２ 文部科学大臣等は、前項の確認（以下単に「確認」という。）を求められた場合において、当該求めに係る大学等が次に掲げる要件（第九条第一項第一号及び第十五条第一項第一号において「確認要件」という。）を満たしていると認めるときは、その確認をするものとする。

1. 大学等の教育の実施体制に関し、大学等が社会で自立し、及び活躍することができる豊かな人間性を備えた創造的な人材を育成するために必要なものとして文部科学省令で定める基準に適合するものであること。
2. 大学等の経営基盤に関し、大学等がその経営を継続的かつ安定的に行うために必要なものとして文部科学省令で定める基準に適合するものであること。
3. 当該大学等の設置者が、第十五条第一項の規定により確認を取り消された大学等の設置者又はこれに準ずる者として政令で定める者で、その取消しの日又はこれに準ずる日として政令で定める日から起算して三年を経過しないものでないこと。
4. 当該大学等の設置者が法人である場合において、その役員のうちに、この法律若しくはこの法律に基づく命令若しくはこれらに基づく処分に違反した者又はこれに準ずる者として政令で定める者で、その違反行為をした日又はこれに準ずる日として政令で定める日から起算して三年を経過しないものがないこと。

３　文部科学大臣等は、確認をしたときは、遅滞なく、その旨をインターネットの利用その他の方法により公表しなければならない。

第十五条　文部科学大臣等は、次の各号のいずれかに該当する場合においては、当該確認大学等に係る確認を取り消すことができる。

1. 確認大学等が、確認要件を満たさなくなったとき。
2. 確認大学等の設置者が、不正の手段により確認を受けていたとき。
3. 前号に掲げるもののほか、確認大学等の設置者が、減免費用の支弁に関し不正な行為をしたとき。
4. 確認大学等の設置者が、第十三条第二項の規定により報告又は帳簿書類その他の物件の提出若しくは提示を命ぜられてこれに従わず、又は虚偽の報告若しくは虚偽の物件の提出若しくは提示をしたとき。
5. 確認大学等の設置者が、第十三条第二項の規定により出頭を求められてこれに応ぜず、同項の規定による質問に対して答弁をせず、若しくは虚偽の答弁をし、又は同項の規定による検査を拒み、妨げ、若しくは忌避したとき。
6. 前各号に掲げる場合のほか、確認大学等の設置者が、この法律若しくはこの法律に基づく命令又はこれらに基づく処分に違反したとき。

２　第七条第三項の規定は、前項の規定による確認の取消しをしたときについて準用する。

　政省令の案は公表されていません。

２．要件確認者

　修学支援法では、授業料等減免を行う際には、大学等は要件の確認を求めることになっています。つまり、授業料等減免を行うにふさわしい要件を満たした機関であることについて確認（証明）を求める（以下、「要件確認」という。）わけです。この要件確認を行う者は、各機関により異なります。

No.	機関	確認者
1	大学（国立学校、私立学校に限る）及び高等専門学校並びに国立大学法人が設置する専門学校	文部科学大臣
2	国が設置する専門学校	当該専門学校が属する国の行政機関の長
3	独立行政法人が設置する専門学校	当該独立行政法人の主務大臣
4	地方公共団体が設置する大学等	当該地方公共団体の長
5	公立大学法人が設置する大学等	当該公立大学法人を設立する地方公共団体の長
6	地方独立行政法人（公立大学法人を除く）が設置する専門学校	当該地方独立行政法人を設立する地方公共団体の長
7	上記を除く専門学校	当該専門学校を所管する都道府県知事

　ここで短期大学の名前がないことに違和感を覚える方もいると思います。おそらく、学校教育法として短期大学は”大学”の一部であるため、短期大学はNo.1（私立）又はNo.4,5（公立）に含まれるのでしょう。同じ考え方で、専門職大学及び専門職短期大学も大学に含まれると解せます。なお、大学院大学は今回の制度の対象外です。

学校教育法　抄

第八十三条の二　前条の大学のうち、深く専門の学芸を教授研究し、専門性が求められる職業を担うための実践的かつ応用的な能力を展開させることを目的とするものは、専門職大学とする。

第百三条　教育研究上特別の必要がある場合においては、第八十五条の規定にかかわらず、学部を置くことなく大学院を置くものを大学とすることができる。
第百八条　大学は、第八十三条第一項に規定する目的に代えて、深く専門の学芸を教授研究し、職業又は実際生活に必要な能力を育成することを主な目的とすることができる。

２　前項に規定する目的をその目的とする大学は、第八十七条第一項の規定にかかわらず、その修業年限を二年又は三年とする。

３　前項の大学は、短期大学と称する。

４　第二項の大学のうち、深く専門の学芸を教授研究し、専門性が求められる職業を担うための実践的かつ応用的な能力を育成することを目的とするものは、専門職短期大学とする。

大学等における修学の支援に関する法律　抄

第二条　この法律において「大学等」とは、大学（学校教育法（昭和二十二年法律第二十六号）第百三条に規定する大学を除く。以下同じ。）、高等専門学校及び専門課程を置く専修学校（第七条第一項及び第十条において「専門学校」という。）をいう。

　どうでもいいですが、No.1の対象機関がA及びB並びにCという「法令の読み方」で最初に習うような形になっている点がおもしろいですね。なお、現時点では、国立大学法人が設置する専門学校は東北大学歯学部附属歯科技工士学校のみだと思います。

３．機関確認要件

　説明会資料により、機関確認要件は以下のとおり整理できます。

修学支援法第7条第2項第1号に定める要件

1. 実務経験のある教員による授業科目が標準単位数（４年制大学の場合、１２４単位）の１割以上、配置されていること。
2. 法人の「理事」に産業界等の外部人材を複数任命していること。
3. 授業計画（シラバス）の作成、GPAなどの成績評価の客観的指標の設定、卒業の認定に関する方針の策定などにより、厳格かつ適正な成績管理を実施・公表していること。
4. 法令に則り、貸借対照表、損益計算書その他の財務諸表等の情報や、定員充足状況や進学・就職の状況など教育活動に係る情報を公表していること。

修学支援法第7条第2項第2号に定める要件

　次のいずれにも該当する大学等でないこと（国（国立大学法人及び独立行政法人を含む。）又は地方公共団体（公立大学法人及び地方独立行政法人を含む。）が設置者である大学等を除く。）

1. 直前の３年度のすべての収支計算書において「経常収支差額」がマイナス
2. 直前の年度の貸借対照表において「運用資産と外部負債の差額」がマイナス
3. 直近３年度のすべての収容定員充足率が８割未満

　以下、各要件の簡単な解説です。

１．実務経験のある教員による授業科目が標準単位数（４年制大学の場合、１２４単位）の１割以上、配置されていること。 

　本要件について、留意点は概ね以下のとおりです。

• 必修科目、選択科目、学部専門科目、教養科目等は問わず、学生が履修できる科目であること。
• 実務家を招くオムニバス科目などでも該当すること。
• シラバス上に教員の実務経験や実務経験の授業内容への活用状況などを明記すること。
• 学問分野の特性により要件を満たすことができない場合は合理的に説明・公表できれば要件を満たすとすること。

　2019年度申請における特例措置は、以下のとおりです。

• 2019年度に要件を満たすことができない理由と2020年度から要件を満たす方向制について説明・公表することで、要件を満たすとすること。
• シラバスとは別の資料（一覧表等）により学生に説明している場合は、要件を満たすとすること。

　この要件については、すでに言及しているとおり、それほど困難であるとは思っていません。強いて言えば、シラバスの構成を変更する必要があるため、システム改修などが発生する可能性があることが気がかりでしょうか。

２．法人の「理事」に産業界等の外部人材を複数任命していること。

　本要件について、留意点は概ね以下のとおりです。

• 国立大学法人においては、理事の員数が3名以下の場合を除くこと。
• 理事が置かれない場合は、学校運営に関わる組織体等に複数の外部人材が参画していること。

　2019年度申請における特例措置は、以下のとおりです。

• 2020年4月1日までに要件を満たすことについて申請者の誓約がある場合には、要件を満たすとすること。

　この要件について、国立大学法人は国立大学法人法が改正され外部理事の複数名化がすでに義務付けられていますので、気にもしていないのが正直なところです。

３．授業計画（シラバス）の作成、GPAなどの成績評価の客観的指標の設定、卒業の認定に関する方針の策定などにより、厳格かつ適正な成績管理を実施・公表していること。

　本要件について、留意点は概ね以下のとおりです。

• シラバスの作成過程や作成・公表時期を申請書に明記すること。
• シラバスにて成績評価の方法や基準を明確にしていること。
• GPAの算出方法を定め、公表していること。
• GPAの分布状況がわかる資料を作成していること。
• DPを公表し適切に実施していること。
• すべての学部等について記載を要するが、各学部等にて概ね同一の取り扱いであればその旨を申請書に明記すること。

　本要件について、2019年度申請における特例措置はありません。

　この要件については、GPAの分布に係る資料がポイントになりそうです。Q&Aでは、1学年分（原則として第1学年）のみの分布でよく、公表は必要ないとしています。

Ｑ「客観的な指標に基づく成績の分布状況を示す資料」（添付書類） は、すべての学年について提出する必要があるのか。

Ａ全学年分を提出する必要はなく、１学年分（原則として第1学年）のみの提出で差し支えない。（以下、略。）

　また、別Q&Aでは”学生の所属する学部等の中でどの位置にあるかを把握できるよう”とありますので、学部等ごとに作成することになると考えています。

４．法令に則り、貸借対照表、損益計算書その他の財務諸表等の情報や、定員充足状況や進学・就職の状況など教育活動に係る情報を公表していること。 

 　本要件について、留意点は概ね以下のとおりです。

• 多くは学校教育法や同法施行規則等で公表が義務付けられている情報が対象であること。
• インターネットの利用等により一般に公表されていることが必要であること。
• 専門学校について特例があること。
• 一部の項目は任意記載事項であること。

 　2019年度申請における特例措置は、以下のとおりです。

• 専門学校において、学校関係者評価の基本方式が定められていれば要件を満たすものとする。

　この要件についても、手持ちの材料でなんとなりそうなので、あまり気にしていません。記述欄や任意記載事項をどの程度まで書き込むかという点にちょっと迷う程度でしょうか。

４．機関確認申請時期

　説明会資料により、機関確認申請のスケジュールの要点は以下の通りです。

• 2019年度の機関要件の確認手続のスケジュールについては、省令制定後、正式に申請書の受理を開始する（省令制定前までの間は、大学等からの事前相談を受け付ける）予定。申請書の提出期限は、７月中旬とする見込み。申請書の提出に関する具体的なスケジュールについては、別途、お知らせします。
• すべての基準に適合することが確認された大学等については、2019年9月中下旬頃を目途として、確認者が公表を行う予定。
• 確認を受けた大学等は、毎年度申請書の内容を更新し、確認者に提出することを要する。
• なお、正式な確認申請書の受理の開始については、関係省令の施行日以後とする予定だが、2019 年度は提出期限までの期間が短くなることを踏まえ、確認申請書の受理の開始前に、準備行為として、確認を受けようとする大学等に確認申請書案の提出を求め、事前審査を実施することが望ましい。

　機関確認申請に係る申請書は、2019年は7月中旬に受け付けられる予定です。それ以前に、申請書の事前確認期間もあるようですので、まずは各大学等とも事前確認を目指して申請書案を作成していくことになるでしょう。なお、確認申請書は、各大学等のホームページ等で公表する必要があります。

確認大学等が確認を受けた年度の翌年度以降も機関要件を満たしていることを明らかにするため、確認大学等は、毎年６月末日までに確認者に対して、確認申請書の内容を更新したものを提出することを要する。確認者は、更新版確認申請書の内容について審査を行う。

　一度要件確認を行ったら終わりではなく、毎年、必要に応じて内容を更新し、申請をを行う必要があります。

　ここまで、期間確認要件を整理しました。大まかに整理したのみであり、学校種に応じて申請書が異なるなど細かい部分で違いがありますので、注意しなければなりません。

　次回は、個人確認要件について整理する予定です。