大学評価基準をそのまま内部質保証に用いるのは困難ではないか。

※本稿では、大学改革支援・学位授与機構が行う大学機関別認証評価を想定して記述しています。

 教育の内部質保証活動においては、大学機関別認証評価の評価基準を活用する場合も多かろうと思います。それはそれでよいのですが、評価基準を内部質保証にそのまま使えるほど簡単な話ではありません。

内部質保証のモデル図

 内部質保証をいかにして表現するか、さまざま考えてきたのですが、最近は以下のとおり考えています。

f:id:samidaretaro:20190726074550p:plain

f:id:samidaretaro:20190726074604p:plain 

 要素としては、以下のとおり整理しています。

  • Focus:保証すべき質を決定する
  • Monitor:各種アセスメント手法を用いて状況を観察する
  • Feedback:観察結果に基づき、フィードバックを行う
  • Reaction:フィードバックに応答し、行動する

 弊ブログでも何度も言及してきましたが、内部質保証の実践においては、保証すべき「質」の検討が最も重要かつ困難であると考えています。そのため、まず保証すべき「質」を決定するFocusが必要です。また、Focusの結果、何を「質」として定めたかは、内部質保証を構成する組織間で共有する必要があります。
場合によっては、Reactionの結果により、Focusの見直しや別分野への移行などもあり得ますね。

 アセスメントを行っていれば内部質保証になるといった話も聞き及びますが、アセスメントはあくまでMonitorの一手段ではなく、それのみでは内部質保証を構成したことにはなりません。

大学評価基準の特徴

 一般的に、評価の方法は水準判定と到達度判定の2つに大別できます。

  • 水準判定:特定の水準を超えているかで評価する方法。Yes/Noで判定できる。大学設置基準における必要専任教員数の判断などが該当。
  • 到達度判定:目標等に対しどの程度到達できたかで評価する方法。国立大学法人評価などが該当。

 大学評価基準は、基準を満たしている/満たしていないで判定する水準判定に分類できるでしょう。

 一方、同基準のなかには目指すべき水準を明記していない場合が多く、判断する水準自体を大学が考える必要があります。これは、認証評価自体が大学の自己点検・評価を基盤にしている証左でしょう。

大学評価基準をそのまま内部質保証に用いる危険性

ここまでの話を以下の2点にまとめます。

  1. 内部質保証には「質」の検討が重要である
  2. 大学評価基準には目指す水準が明記されていない

 大学評価基準に明記されていない「水準」とは「質」のことでもあると考えられ、その前提では、大学評価基準には「質」が明記されていないと言えます。そのため、大学評価基準をそのまま内部質保証の基準として用いる場合、拠り所となる多数の基準において向上させるべき「質」が不明であり、大学の質保証の取組が迷走することも想定できます。大学評価基準にはゴールが書かれていないのですから。

 一方、改正された学校教育法第109条第6項では認証評価の認定を受けるように努力することとなっており、大学評価基準を無視することもできません。

 そうなると、学内の他の事項(中長期計画や事業計画など)と認証評価基準とを関連付け、それを踏まえて内部質保証に対応することがよいのではないかと考えています。特に、私立大学であれば、改正された私立学校法により事業に関する中期的な計画の作成が義務付けられたこともあり、既存の計画も含め、しっかりと関連付けていきたいところです。(カバーできない基準は落穂拾い的に対応していくことになるでしょう)

内部質保証の本質

 ところで、内部質保証の本質は、組織間の対話・交渉であると考えています。この前提に立つと、一般的に調整役になることが多い事務職員にとっては、活躍できる場面もあるのではないでしょうか。逆に言えば、没交渉である組織が存在する場合の内部質保証をどのように担保すべきかは、考えなければなりません。

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

文科省Q&A更新の影響

高等教育段階の教育費負担新制度に係る質問と回答(Q&A):文部科学省

Q101
GPA等の客観的指標が、学部等で下位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以下の個数の合計としていました。しかし、文科省の見解では、ライン上に複数名が存在している場合は全員を警告ラインから除外するとしています。これは、下図の通り整理できます。

f:id:samidaretaro:20190708192314p:plain

 これについて、一晩かけて対応を検討し、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未満の個数

f:id:samidaretaro:20190708192224p:plain
 文科省の言う「下位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. 下位4分の1の人数がわかる表を作成(前述)
  2. 累積頻度0.25前後の者がわかる表を作成
  3. 「本シート以外印刷」機能
  4. 「本シート以外印刷(氏名非表示)」機能

f:id:samidaretaro:20190706134732p:plain

※上記図中の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%の算出方法が明らかになり当該マクロの算出方法と異なっていたため、公開を中止します。

f:id:samidaretaro:20190701210506p:plain

 ヒストグラムの下に、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で行っています。

f:id:samidaretaro:20190620075213p:plain

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

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

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

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

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

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

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

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

f:id:samidaretaro:20190620075351p:plain

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

 作成された新たなシートは、初期設定でA4横一枚に収めて印刷できるようにしてあるので、マクロボタン押下→シート印刷という最短でのレポーティングが可能です。(本当はヒストグラムの中に下位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

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

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

1.授業料減免のスケジュール等

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

2.GPAの算出方法

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

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

3.既存の支援制度との関係

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

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

<2019年度文部科学関係予算(案)主要事項>

f:id:samidaretaro:20190615195820p:plain

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

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

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

1.根拠法 

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

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

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

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

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

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

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

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

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

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

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

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

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

2.概要

1.採用時の支援認定要件 

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

f:id:samidaretaro:20190531211547p:plain

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

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

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

(4)支援措置の対象となる学生等の認定に関する手続(別紙3参照)

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

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

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

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

2.継続時の支援認定要件(適格認定の基準)

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

f:id:samidaretaro:20190531230522p:plain

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

(6)支援措置の実施に関する手続等(別紙6参照)

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

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

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

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

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

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

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

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

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

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

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

3.支援要件確認の整理

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

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

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

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

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

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

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

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

4.スケジュールの推測

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

f:id:samidaretaro:20190531230618p:plain

f:id:samidaretaro:20190531230646p:plain

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

f:id:samidaretaro:20190531230708p:plain

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

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

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

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

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

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

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

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


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

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

nikkan-spa.jp

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

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

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

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