職員が自大学のことを知る3つの方法(この時期だからこそできることを含む)

 先日、入職3年程度までの職員と会食していた際、勤務している大学のことを知るにはどのような方法があるのかという質問を受けました。幣BLOGでも何度か言及してきましたが、この時期だからこそできることを含め、以下の3つの方法を整理します。

1.教員が書いた書籍を読む

kakichirashi.hatenadiary.jp

 すでに幣BLOGでもお話しした通り、教員が書いた書籍を読むことで、各教員の教育研究内容を理解する手掛かりになります。自大学の図書館ならば配架していることも多いと思いますので、図書館を利用するのもよいですね。

2.一般向けの広報物を読んだりイベントに参加する

 職員と言えども、入職一年目などは一般の方と大きく知識が異なるわけではありません。そのため、まずは一般向けの広報活動を把握するところから始めてみてはいかがでしょうか。

 各大学は、おそらく一般向けの広報物を発行しています。web上でも公開されていることと思いますので、過去発行分も含め、それを通読しましょう。また、HPなどで告知されている公開講座等一般の方向けのイベントにも、予定と興味関心が合えば参加してみてもいいでしょうね。そこから始めれば、学内会議資料や自己点検・評価報告書などの詳細な資料も読み解けるようになるかもしれません。

 各大学が行う公開講座は各大学のHPにて情報提供されていますが、一部の大学の講座は以下のサイトでも検索できます。

www.second-academy.com

3.最終講義に参加する

12月ごろから、退職する教員の最後の講演(いわゆる最終講義)の案内が始まることでしょう。

www.u-tokyo.ac.jp

 その教員が行う最終講義は、人生で一度あるいは数度しかありません。お世話になっている教員や興味関心のある分野などの最終講義は、教育研究内容だけではなく教員の人生観やなども聞くことができます。ゼミOBなどが対象でハードルが高いと思われがちですが、私が何度か参加した範囲では通常の公開講座と同じような進行でした(医学系はわかりませんが・・・)。

 最終講義はこの機会しか聞けませんので、予定と興味関心が合えば参加してみましょう。私も、今年もいくつか聞きに行く予定です。

美大予備校では東京藝術大学の出願資格を得られない可能性がある。

anond.hatelabo.jp

「高校進学することなく、中卒後即座に大手美大予備校の昼間部に所属し、3年間誰よりもデッサンと色彩構成と立体制作に明け暮れ、現役で東京藝術大学デザイン科に合格する」
という事をキャリアパスとして考えています。
この進路の舵取りは一般的に考えて極論中の極論だとは思いますが、この事の是非を質問として問いたいです。いかがでしょうか。

 結論から言うと、将来の夢はともかく、東京藝術大学の入学者選抜試験を受験できない(試験を受けて不合格になるのではなく、そもそも出願資格を得られない)可能性があるため必要な行動を慎重に考えたほうが良いですね。

 以下、現在の状況を踏まえて、もし私が同じ質問を受けたたらどのような根拠でどのように回答するかという視点で整理します。なお、当該者が受験するであろう令和5年度入試に同じ状況であるかは保証しません。

1.大学入学者選抜に係る法令等

 各大学で実施される大学入学者選抜は、好き勝手なんでもできるわけではなく、入学できる者や選抜方法の大枠が法令等により決まっています。各大学は、これらも踏まえ、入学者選抜試験を実施しています。

学校教育法

第九十条 大学に入学することのできる者は、高等学校若しくは中等教育学校を卒業した者若しくは通常の課程による十二年の学校教育を修了した者(通常の課程以外の課程によりこれに相当する学校教育を修了した者を含む。)又は文部科学大臣の定めるところにより、これと同等以上の学力があると認められた者とする。

2 前項の規定にかかわらず、次の各号に該当する大学は、文部科学大臣の定めるところにより、高等学校に文部科学大臣の定める年数以上在学した者(これに準ずる者として文部科学大臣が定める者を含む。)であつて、当該大学の定める分野において特に優れた資質を有すると認めるものを、当該大学に入学させることができる。

一 当該分野に関する教育研究が行われている大学院が置かれていること。

二 当該分野における特に優れた資質を有する者の育成を図るのにふさわしい教育研究上の実績及び指導体制を有すること。

学校教育法施行規則

第百五十条 学校教育法第九十条第一項の規定により、大学入学に関し、高等学校を卒業した者と同等以上の学力があると認められる者は、次の各号のいずれかに該当する者とする。
一 外国において学校教育における十二年の課程を修了した者又はこれに準ずる者で文部科学大臣の指定したもの

二 文部科学大臣が高等学校の課程と同等の課程を有するものとして認定した在外教育施設の当該課程を修了した者

三 専修学校の高等課程(修業年限が三年以上であることその他の文部科学大臣が定める基準を満たすものに限る。)で文部科学大臣が別に指定するものを文部科学大臣が定める日以後に修了した者

四 文部科学大臣の指定した者

五 高等学校卒業程度認定試験規則による高等学校卒業程度認定試験に合格した者(旧規程による大学入学資格検定(以下「旧検定」という。)に合格した者を含む。)

六 学校教育法第九十条第二項の規定により大学に入学した者であつて、当該者をその後に入学させる大学において、大学における教育を受けるにふさわしい学力があると認めたもの

七 大学において、個別の入学資格審査により、高等学校を卒業した者と同等以上の学力があると認めた者で、十八歳に達したもの

第百五十一条 学校教育法第九十条第二項の規定により学生を入学させる大学は、特に優れた資質を有すると認めるに当たつては、入学しようとする者の在学する学校の校長の推薦を求める等により、同項の入学に関する制度が適切に運用されるよう工夫を行うものとする。

第百五十二条 学校教育法第九十条第二項の規定により学生を入学させる大学は、同項の入学に関する制度の運用の状況について、同法第百九条第一項に規定する点検及び評価を行い、その結果を公表しなければならない。

第百五十三条 学校教育法第九十条第二項に規定する文部科学大臣の定める年数は、二年とする。

第百五十四条 学校教育法第九十条第二項の規定により、高等学校に文部科学大臣が定める年数以上在学した者に準ずる者を、次の各号のいずれかに該当する者と定める。

一 中等教育学校の後期課程、特別支援学校の高等部又は高等専門学校に二年以上在学した者

二 外国において、学校教育における九年の課程に引き続く学校教育の課程に二年以上在学した者

三 文部科学大臣が高等学校の課程と同等の課程を有するものとして認定した在外教育施設(高等学校の課程に相当する課程を有するものとして指定したものを含む。)の当該課程に二年以上在学した者

四 第百五十条第三号の規定により文部科学大臣が別に指定する専修学校の高等課程に同号に規定する文部科学大臣が定める日以後において二年以上在学した者

五 文部科学大臣が指定した者

六 高等学校卒業程度認定試験規則第四条に定める試験科目の全部(試験の免除を受けた試験科目を除く。)について合格点を得た者(旧規程第四条に規定する受検科目の全部(旧検定の一部免除を受けた者については、その免除を受けた科目を除く。)について合格点を得た者を含む。)で、十七歳に達したもの

入学者選抜実施要項:文部科学省

令和2年度大学入学者選抜実施要項について(通知)

標記の要項について,国公私立大学関係者及び高等学校関係者等の審議を踏まえ,別紙のとおり定めましたので通知します。

先月末に公表した「大学入学者選抜の公正確保等に向けた方策について(最終報告)」を踏まえたルールや調査書の電子化について,関係の諸事項を加えております。

各大学においては,本要項に基づき大学入学者選抜を適切に実施するとともに,引き続き入学者選抜方法の工夫・改善を進めるようお願いいたします。

2.東京藝術大学の出願資格

 東京藝術大学の2020年度(令和2年度)入学者選抜要項によれば、出願資格は以下のとおりです。

次のいずれかに該当する者で,本学の学部・学科で定める2020年度(令和2年度)大学入学者選抜大学入試センター試験(以下「大学入試センター試験」という。)の教科・科目のすべてを受験した者とする。【〔表3 〕9頁・〔表4 〕10頁参照】

(1)高等学校若しくは中等教育学校を卒業した者及び2020 年3 月卒業見込みの者

(2)通常の課程による12年の学校教育を修了した者,又は通常の課程以外の課程によりこれに相当する学校教育を修了した者及び2020 年3 月修了見込みの者

(3)高等学校を卒業した者と同等以上の学力があると認められる者及び2020 年3 月31日までに,これに該当する見込みの者

ア 外国において学校教育における12年の課程を修了した者及び2020年3 月31日までに修了見込みの者,又はこれに準ずる者で文部科学大臣の指定したもの

イ 文部科学大臣が高等学校の課程と同等の課程を有するものとして認定した在外教育施設の当該課程を修了した者及び2020 年3 月31日までに修了見込みの者

ウ 専修学校の高等課程(修学年限が3 年以上であることその他の文部科学大臣が定める基準を満たすものに限る。)で文部科学大臣が別に指定するものを文部科学大臣が定める日以後に修了した者

エ 文部科学大臣の指定した者

オ 高等学校卒業程度認定試験規則による高等学校卒業程度認定試験に合格した者(旧規定による大学入学資格検定に合格した者を含む。)及び2020年3月31日までに合格見込みの者で,2020年3月31日までに18歳に達する者

カ 本学において,個別の入学資格審査により,高等学校を卒業した者と同等以上の学力があると認めた者で,2020年3月31日までに18歳に達するもの

 (1)は、通常の高校や中等教育学校(ざっくり言うと中学校と高校が一体化した学校)の卒業生が該当します。

 (2)は、学校教育法逐条解説(コンメンタール)によれば、特別支援学校卒業生や高等専門学校3年次修了者が該当するものと考えられるようです。

 (3)について、今回のケースに該当すると考えられるのは、ウ・オ・カです。

 ウは、文部科学大臣指定専修学校高等課程一覧に該当する学科等を修了した者が該当します。美術系の専修学校高等課程も散見されますので、場合によっては、美大予備校でも出願資格が認められるかもしれません。

 オは、高等学校卒業程度認定試験高認試験、昔の大検)に合格した者が該当します。美術予備校に関するウェブページでも、高認試験の受験を勧めています。

高卒資格がないけど美大にいきたい!美大受験に備えて何が必要?

美大だけに限りませんが、大学へ進学するためには高卒資格が必要です。すでに退学したのであれば、「高卒認定」を取得しておきましょう。高卒認定試験は毎年8月と11月に行われ、合格すると「高校卒業と同程度の学力を有する」と認められた証となるものです。16歳以上で受けられるため、18歳を待たずに取得できます。
高卒認定試験は全8科目を一度に受ける必要はありませんが、全て合格する必要が。そのため、美大合格に欠かせない基礎的な画力を伸ばす前に試験勉強に取り組む必要があります

※一部誤解を招く表現があります。「16歳以上で受けられるため、18歳を待たずに取得できます。」とありますが、試験の合格に関わらず、合格者と認められるのは満18歳の退場日の翌日からです。そのため、オには「2020年3月31日までに合格見込みの者で,2020年3月31日までに18歳に達する者」という表現があります。

 カは、東京藝術大学が行う資格審査に合格した者が該当します。この審査は、「東京藝術大学個別入学資格審査に関する実施要項」に則り行われますが、審査の要件として高等学校相当の学習歴3年以上、学習歴の内容が高等学校学習指導要領に準ずると認められることが定められています。美術予備校がこれに該当するかは、ちょっとわからないですね。

3.東京藝術大学美術学部デザイン科の入学者選抜

 東京藝術大学の2020年度(令和2年度)入学者選抜要項によれば、美術学部デザイン科の入学者選抜方法は以下のとおりです。

大学入試センター試験:3教科3科目または4科目(国語及び外国語は必須)

個別学力検査:鉛筆写生、デザインⅠ(色彩)、デザインⅡ(形体)

●1次:個別学力検査等の成績により合否を判定する。●2次:2次個別学力検査等までの成績に,大学入試センター試験成績と出願書類(調査書等)の審査を加え,総合的に判定し,合否を決定する。

センター試験成績がどこまで重みづけされるのかはわかりませんが、それなりに勉強が必要なのかもしれません。

同要項によれば、平成31年度入試のデザイン学科の結果は以下のとおりです。

入学定員:45

志願者数:665

受験者数:646

合格者数:44

入学者数:44

受験倍率:14.8

4.東京藝術大学の出願資格を得るためには

 以上を踏まえ、美大予備校に通うという前提で東京藝術大学の出願資格を得るためには、以下の進路が考えられるかと思っています。2は限りなく少ないだろうと思うので、1か3が妥当なところでしょう。

  1. 高等学校に進学し、美大予備校にも通う(ダブルスクール
  2. 文部科学大臣指定専修学校高等課程一覧に該当する美大予備校に進学する
  3. 文部科学大臣指定専修学校高等課程一覧に該当しない美大予備校に進学し、高等学校卒業程度認定試験に合格する

 あるいは、大学が独自に行う個別の入学資格審査について東京藝術大学に問い合わせ、過去に美大予備校修了者に入学資格を与えたことがあるのか、具体的にはどの美大予備校かを聞いてもいいかもしれません(おそらく、個別事例なので教えてもらえないかもしれませんし、予備校では「高等学校相当の学習歴3年以上、学習歴の内容が高等学校学習指導要領に準ずる」と認められないのではないかと思いますが)。

 いずれの進路にしろ、高等学校学習指導要領に準拠した教育を受ける/学習を行うことは必要ではないかと感じています。

大学はどのように避難所の運営に関われるのか。

鍵の所在不明、避難所開けず 埼玉県幸手市の2カ所|全国・海外のニュース|徳島新聞

市の危機管理防災課によると、13日午前1時に災害対策本部を設置し、避難所開設を始めた。小中学校や市の施設は市で管理していた鍵で開けられたが、幸手看護専門学校と日本保健医療大の校舎については鍵の所在が分からず、学校側とも連絡が取れなかったため、開けなかった。

 多くの大学が避難所として指定されている中いつかこのような問題が生じるだろうなと思っていましたが、やはり発生していたようですね。

 避難所の運営は基本的には市町村が行うでしょうが、平時はともかく、特に今回のように休日の夜間など一般的に大学が閉鎖(事務局の大半が不在)している時は大学側が扉の解鍵や備品の準備を主導しなければなりません。

 おそらく、今回のようなケースには、

  1. 市町村職員が大学へ到着
  2. 守衛室から関係する大学職員へ連絡
  3. 関係する大学職員が大学に到着
  4. 関係する大学職員が市町村職員と連携して扉の解錠、備品の準備等を行う

のような順序で対応することになるでしょう。この場合、3.の職員が到着することができるのか、4.の職員が適切に対応できるのかがポイントになりそうです。私自身、一時期は勤務校の非常に近くに住んでいましたし、災害避難情報を踏まえ深夜に勤務校に避難(と言う名の所掌業務の災害対応)したこともあります。個人的には担当部署に災害時の初期対応について確認もしていましたが、もしその時になった場合はどの程度の権限で動けるのか不安でした。

 例えば、信州大学は避難所等の運営協力に関する基本指針を公表していますし、東日本大震災などの対応経験も活かせるところが多くあります。このあたりも参考にしたいところです。

 普段、(なぜかすでに災害対策本部テントが設営してある)避難訓練や(なぜか普段倉庫にしまってある備品がすでに机の上にある)避難誘導訓練を行うこともありますが、市町村役場と連携した避難所設営訓練も必要だなと感じたニュースでした。

修学支援新制度の対象から大学院生が除外されている件について

next49.hatenadiary.jp

 修学支援新設度(以下、「新制度」という)については、確認申請書の提出締め切りが過ぎ、各確認者にて確認を行っているところでしょうか。そんな中、新制度の対象に大学院生が含まれていないことについて話題になっています。この件について、整理してみます。

事実関係の整理

文科省のQ&A

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

Q67 大学院生は新制度の支援対象になりますか。

A67 大学院生は対象になりません。(大学院への進学は18歳人口の5.5%に留まっており、短期大学や2年制の専門学校を卒業した者では20歳以上で就労し、一定の稼得能力がある者がいることを踏まえれば、こうした者とのバランスを考える必要があること等の理由から、このような取扱いをしているものです。)

 文部科学省のQ&Aでは、新制度の対象から大学院が除かれていることが明記されています。なお、従前から国費にて各大学で行われてきた授業料減免・入学料免除制度では、大学院生や留学生も対象に含まれています。今回は、従前からある減免・免除制度と新制度との対象者の違いにより、それまで支援を受けられていた大学院生が支援を受けられなくなるのではないかという懸念から生じているのでしょう。

新しい経済政策パッケージ

 新制度に大学院生を含まないことは、文部科学省の制度設計ではなく、内閣が決定した方針にてすでに決まっていました。ただし、これがどのように決まったのかまでは調べきれませんでした。

新しい経済政策パッケージ(平成29年12月8日閣議決定)

第2章 人づくり革命

3.高等教育の無償化

最終学歴によって平均賃金に差があることは厳然たる事実※5である。また、貧しい家庭の子供たちほど大学への進学率が低い、これもまた事実である。貧困の連鎖を断ち切り、格差の固定化を防ぐため、どんなに貧しい家庭に育っても、意欲さえあれば専修学校、大学に進学できる社会へと改革する。所得が低い家庭の子供たち、真に必要な子供たちに限って高等教育の無償化を実現する※6。

※6高等教育の無償化は、大学、短期大学、高等専門学校、専門学校について行う。

2−4

文科省のエージェンシー化

 余談ですが、最近の文教政策は内閣府財務省、政権与党などの会議体で目的・目標や方針が決まり、文科省はそれを実行するだけという、ある意味で文科省独立行政法人化(エージェンシー化)が進んでいると強く感じています。

なぜ大学院生が除外されているのか

修学支援新制度の目的は少子化対策である

 前述の「新しい経済政策パッケージ」の策定時点で大学院生が新制度の対象から除外されています。同パッケージの策定過程が公表されていないため、なぜ大学院生が除外されているのかは明確ではありません。ただ、新制度の趣旨が少子化対策であることに関係しているのではないかと考えています。

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

(目的)

第一条この法律は、真に支援が必要な低所得者世帯の者に対し、社会で自立し、及び活躍することができる豊かな人間性を備えた創造的な人材を育成するために必要な質の高い教育を実施する大学等における修学の支援を行い、その修学に係る経済的負担を軽減することにより、子どもを安心して生み、育てることができる環境の整備を図り、もって我が国における急速な少子化の進展への対処に寄与することを目的とする。

 あまり知られていませんが、大学等における修学の支援に関する法律の目的は少子化の進展への対処に寄与することです。学費の無償化と少子化との関係はイメージにしにくいところであり、条文中には「修学に係る経済的負担を軽減することにより、子どもを安心して生み、育てることができる環境の整備を図」りとありますが、こじつけ感も覚えますね。このように少子化を法律の目的としたことは、同法を根拠として実施する修学支援新制度が消費税を財源としているためです。

消費税法

(趣旨等)

第一条 

2 消費税の収入については、地方交付税法(昭和二十五年法律第二百十一号)に定めるところによるほか、毎年度、制度として確立された年金、医療及び介護の社会保障給付並びに少子化に対処するための施策に要する経費に充てるものとする。

 平成24年8月に成立した「社会保障の安定財源の確保等を図る税制の抜本的な改革を行うための消費税法の一部を改正する等の法律」により消費税法の一部が改正され、消費税収入の使途が明記されました。

 その後、当初は消費税10%増税分収入は財政赤字の削減と社会保障費の充実に充てられる予定でしたが、その中から「人づくり革命」と呼ばれる少子化対策に充てられるよう使途変更が行われました。

消費増税による増収分の使途変更(みずほインサイト2017.9.26)

消費税増税の使い道をわかりやすく解説 | 消費税・軽減税率情報Cafe

 よって、消費増税を原資とする奨学支援新制度においては、少子化に対処すること以外に目的を設定する選択肢はない状況だったと言えます。このことは、文科省専門家会議の委員だった小林・東京大学教授も解説しています

 ここから、今回の新制度は既存の授業料減免・入学料免除制度とは、全く趣旨が異なるもの(継続性がないもの)と考えられます。大学院生を新制度の対象外とすることについては研究力やイノベーション誘発力の低下などの意見も見られましたが、そもそも制度の目的が異なるということですね。

 とは言っても免除者は継続的に存在しているため、どのように対応していくのかが問題になっています。

大学院は一般的な学歴のゴールとして想定されていないのではないか

 ここから先は全て私の推測です。

 新制度の対象は、大学・短大・高専・専門学校等と概ね18歳の進学先を網羅しています。ここから、奨学制度と言いつつも、特定の世代(主として18歳から22歳、またその親世代)への支援制度とも言えるのではないかと感じています。特定の世代に広く支援する場合、社会一般としてどのように整理をつけるかということが重要になります。その意味では、社会一般としてのストレートの学歴ゴール(あまりいい言葉ではありませんが。。。)として、新制度の対象となっている学校種が整理されたと考えることができます。(本来ならば、住民税非課税世帯やそれに準ずる世帯の進学状況を踏まえて検討すべきだと思いますが、それを見つけることができませんでした。。。)

 平成29年度就業状況基本調査から、15歳以上の最終学歴を以下の通り整理します。

f:id:samidaretaro:20190727102102p:plain

 大学院進学割合を考えると、原資が限られていることもあり、やはり大学・短大等をひとまずのゴールと置いたのでしょうか。

今後の展開

国会審議の状況

 次年度以降、大学院生や留学生に対する授業料減免・入学料免除の措置がどのようになるか、気になるところです。大学によっては億単位の原資が必要となるため、やはり国費の投入がなければ対応は難しいかもしれません。最近の国会審議の状況からは、以下の通りの発言が見受けられます。

198 - 衆 - 財務金融委員会 - 13号 令和01年05月15日

○森政府参考人 特に国立大学の運営費交付金の授業料減免の予算措置につきましては、経済的な理由、それから留学生、大学院生等を含めまして措置をしております。
 その中で、実際の、先ほど申し上げましたように繰り返しになりますけれども、どのような所得要件にするか、新制度においては住民税の課税標準額をベースにいたしますけれども、各大学においては年収基準をもとにしているところが多いわけでございますけれども、それについてはそれぞれの大学で決めてきた、そういうことでございます。

○宮本委員 ですから、それぞれの大学で、今回の法律よりももっと大きな幅で減免をやってきたわけですよ。それを支援してきたわけですよ。そして、もっと対象を拡大しなきゃいけないということで、ずっと積み上げてきたわけじゃないですか。なぜその認識を捨てようとするのか。
 私、国の今度の施策によって、授業料減免の対象が縮小する大学が生まれるというのは、国連人権規約にあります高等教育の漸進的無償化に逆行すると思いますよ。その点の認識、文科副大臣、いかがですか。

○永岡副大臣 お答えいたします。
 国際人権規約におきまして、無償教育の具体的な方法については特段の定めをしておりません。その範囲や方法を含めまして、具体的にどのような方法をとるかについては加盟国に委ねられております。
 文部科学省としては、財政や進学率等その時々の状況を総合的に判断しながら、具体的な、給付型の奨学金制度の創設を始め、奨学金制度を充実させるなど、教育費負担の軽減に努めているものでございます。
 新制度は、真に支援が必要な学生に対しまして確実に授業料等が減免されるよう、大学等を通じた支援を行うとともに、学生生活の費用をカバーするために十分な給付型の奨学金を支給するものでございます。全体としては、規模や金額が大幅に拡大することで支援が広がっていくものと考えております。
 このため、中長期的に見まして、無償教育という手段を徐々に、漸進的に導入する方向に沿って努力していく方針が維持され、そして実際の施策が中長期的に見ましてその方向性に沿ったものとなっていることから、無償教育の漸進的導入の趣旨に適しているものと認識をしている次第でございます。

○宮本委員 私は、今度の法律について適しているかどうか聞いたわけじゃないんですね。法律は成立しました、法律が成立したもとで、今度、今まで続いてきた授業料の減免制度をどうするかということが問われているわけですよ。今までの授業料減免制度は法律に基づいてやっているわけじゃないですから。
 この減免制度を縮小していくということになったら、これは当然、漸進的無償化というのは前に進んでいくわけですから、その部分が対象が少なくなるというのは、明確に逆行するということを言わなければいけないと思います。
 私、本当に大変心配するのは、先ほど来、各大学で減免制度は考えてくれということを大臣はおっしゃるわけですよね。これは、今まで同様の財政措置がなくなったらどうなるかということなんですよね。
 各大学は、そうはいっても、やはり減免制度を続けたいと思いますよ。自主財源を確保しようという話になりますよ、もし財政措置がとられなければ。寄附金が集まればいいですけれども、寄附金が集まらなければどうなるのか。自主財源といったら、授業料を上げることになるんですよね。実際、ずっと据え置かれていた国立大の授業料ですけれども、ことし、東工大と芸大が値上げするということになりました。
 ですから、私が本当に言っておきたいのは、減免制度を各大学で維持する財源を学生や父母に求めるような、授業料値上げで賄うようなことは絶対あってはならない、そういう方向に誘導しては絶対ならないと思いますが、その点の文科副大臣の認識をお伺いしたいと思います。

198 - 参 - 文教科学委員会 - 7号 令和01年05月09日

○神本美恵子君 (略)
 一番大きな問題は、この間の現行の授業料減免について、文科省は留学生や大学院生については目的が異なるので継続して支援するとされておりますけれども、今受けている在学中の、現行制度で授業料減免を受けている、そういう人たちに対しては対策がちゃんと取られるのかということについて聞いたら、国立大学については何らかの配慮が必要かどうか検討中、また、私立については、現行の私立大学等経常費補助金配分基準で授業料減免事業等支援がありますけれども、新制度に移行した後どうなるかということについてははっきりおっしゃっていないんですね。大学の対応を見極めつつというような答弁がされておりますけれども、現行の制度が後退、縮小する懸念は拭えていないんです、これまでの議論では。
 大臣、はっきりここは後退しないと、縮小しないというふうに、それだけの予算獲得をするんだということを明言していただきたいと思います。いかがですか。

国務大臣柴山昌彦君) 現行の各大学における授業料減免は、それぞれが定める認定基準に基づいて本当に多様な形で行われております。これが、新制度の下では、二〇二〇年度から各大学における授業料減免への公的支援が、国公私を通じ、全国で統一的な基準によって真に支援が必要な住民税非課税世帯及びこれに準ずる世帯の学生に対して重点的に行われることになるというように考えております。総合的な支援の額は大幅に増えてまいります。
 それでは、個別の大学についてどうかということなんですけれども、今後、各大学においてこの新制度を踏まえてどのように対応するかということをそれぞれ検討していただくこととなりますけれども、文部科学省といたしましては、本年夏頃までをめどとして、必要な調査等を行った上で適切に対応してまいりたいと考えております。

○高木かおり君 (略)
 続きまして、もう最後の質問になるかもしれませんが、先ほどもお話が出ていましたが、大学の学費の値上げで一番打撃を受けるというのは、やっぱり中間層であるというふうに思います。我が党は、そもそも所得制限なしの大学、高等教育の無償化を訴えてはおりますけれども、今少しずつ前進していく中でも、やはりこの中間所得層の学生さんたちが大変今困難な状況にあるというふうに思います。学生さんたちがプロジェクトを立ち上げた中でのアンケートによりますと、世帯年収四百万から八百万の世帯の学生さんたちが、もう高い学費ということに、こういった壁に大変悩んでいるということをお聞きをいたしました。
 今までは、国立大学の場合に限りますけれども、国立大学の場合、大学院生ですとか、年収が先ほど申し上げた中間所得層の中でも、成績が良かったら授業料の減免を受けることができたという制度もありました。だけれども、今回の新制度によって、こういったことに対しても減免措置が打ち切られたり後退するということがあるのかどうか。これは大学が決めることだというふうな御回答かもしれないんですけれども、やはりこういったことも大学が、じゃ、やめようかというふうになってしまうということではやはり後退ということになってしまうのかなというふうに感じるんですけれども、その点はどうでしょうか。

○政府参考人(伯井美徳君) 新制度の下におきましては、まず、この新制度に基づく統一の基準による支援制度ができると、その上で、それを踏まえて各大学がどのように対応するかということでございます。
 今後、国立大学につきましては、各国立大学において新制度を踏まえてどのように対応するか、それぞれ検討していくわけでございますが、その中で、先般大臣もお答えされましたように、新制度において対象とならない学生も生じ得るというところでございます。それにつきましては、当該学生の学びの継続を支援するという観点から、減免の事由、家計基準の実態、国立大学における減免基準の考え方などを見極めつつ、一定の配慮について検討をしていくことが必要であるというふうに考えております。
 そのため、文科省としては、各国立大学に対して一定の調査をするなどいたしまして、より詳細な状況を把握した上で新たな制度の趣旨を踏まえ、適切に対応していきたいというふうに考えております。

198 - 参 - 文教科学委員会 - 5号 平成31年04月23日
斎藤嘉隆君 是非大臣、本当にこれ学生たちにとっては死活問題なので、新制度で七千数百億円という予算で非課税世帯の子供たちが大学に行きやすくなるというのは、これは本当に有り難いことだと思いますけれども、そのことの導入と引換えに従来の五百数十億円という予算が削られて各大学の減免が縮小していくなんということがあったら、これはむしろマイナスの方が大きい、そのように言わざるを得ないんです。
 もう一点お聞きします。
 大学院生への支援、新制度は大学院生対象外ですね。これ、新制度によって従来の制度の継続が左右されるようなものではないと思います。二〇一九年度は一万七千人が免除対象ですけれども、二〇二〇年も、これは規模も含めて維持をしていくという方向でよろしいですか。
国務大臣柴山昌彦君) 今委員御指摘のとおり、今回の新たな支援制度は学部学生を対象としたものでありますけれども、ただ、国立大学の大学院生に対する授業料の減免は運営費交付金より別途措置されておりますので、引き続きしっかりと対応していきたいと考えております。

予算の話はまだ確実に言えない

 「しっかりと対応していきたい」とありますし、現に大学にそれらしい調査も来ています。ただ、概算要求事項も明らかになっていない中で来年度の予算のことは根拠なく話すことはできないと思います。そのため、今後の対応は不明というのが正確なところでしょう。もし文科省担当者が現時点で「大丈夫ですよ。継続されますよ。」と言ったのなら、ちょっと軽率だなという印象です。

 個人的には、最低限、従前からの減免・免除枠から今回の制度分を除外した金額を配分してほしいと考えています。

本件に関する所感

 そもそも、授業料減免・入学料免除を少子化対策として位置づけことが無理筋なのではないかと思います。予算の都合上タテマエとして設けた目的目標が後の行動を縛っていくという構図は大学でもよく見る風景だなと感じました。

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

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

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

内部質保証のモデル図

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

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