ここから本文です

時間割担当です。条件が厳しいため、ソフトは使っていません。ただ、少しでも効率...

mmr********さん

2020/4/422:55:58

時間割担当です。条件が厳しいため、ソフトは使っていません。ただ、少しでも効率的にやりたいです。いつもは手動ですが、ある程度自動でできないでしょうか。学年色は1年黄色、2年赤、3年緑です。

シート1の教師用時間割を動かしたらシート2の生徒用時間割に自動で反映されたら嬉しいです。
EX)1年生の国語担当の先生を動かす場合
月1に1-1と入力したら、自動で黄色に塗られ、生徒用時間割の1-1の月1に「国語」と入力される。
月2に1-2と入力したら、自動で黄色に塗られ、生徒用時間割の1-2の月2に「国語」と入力される。
EX)2年生の国語担当の先生を動かす場合
月1に2-1と入力したら、自動で赤色に塗られ、生徒用時間割の2-1の月1に「国語」と入力される。※2-3と入力したら、同様に2-3の月1に「国語」と入力
月2に2-2と入力したら、自動で黄色に塗られ、生徒用時間割の2-2の月2に「国語」と入力される。
EX)3年生の国語担当の先生を動かす場合
月1に3-1と入力したら、自動で赤色に塗られ、生徒用時間割の3-1の月1に「国語」と入力される。
月2に3-2と入力したら、自動で黄色に塗られ、生徒用時間割の3-2の月2に「国語」と入力される。

対応させるのが国語だけでなく、すべての教科なので、とても難しいとは思いますが、お知恵をいただきたいです。教員の長時間労働解消のためによろしくお願いいたします。

国語,生徒用時間割,国語担当,赤色,シート,End If,End With

閲覧数:
151
回答数:
2
お礼:
500枚

違反報告

ベストアンサーに選ばれた回答

プロフィール画像

カテゴリマスター

kky********さん

2020/4/518:39:12

マクロでいいなら、添付した通りのレイアウトで出来ます。
標準モジュールに下記を記載して実行します。

Option Explicit

Sub test()
Dim sh As Worksheet
Dim rng As Range
Dim r As Integer, c As Integer
Dim ck As Variant
Application.ScreenUpdating = False
Set sh = Worksheets("Sheet2")
With sh
.Range("B4:AI14").ClearContents
Set rng = .Range("A1:A14")
End With
With Worksheets("Sheet1")
For r = 4 To 37
If r Mod 7 <> 3 Then
For c = 3 To 31
If .Cells(r, c) <> "" Then
ck = Application.Match(.Cells(r, c), rng, 0)
If IsError(ck) = False Then
sh.Cells(ck, r - 2) = .Cells(3, c)
End If
End If
Next c
End If
Next r
End With
Application.ScreenUpdating = True
End Sub


基本的な事は下記サイトなどを見て下さい。

標準モジュール
http://officetanaka.net/excel/vba/beginner/10.htm

実行方法
https://www.ex-it-blog.com/Macro-exe

全体的な基礎事項
https://www.tipsfound.com/vba/01004

  • 質問者

    mmr********さん

    2020/4/522:55:04

    すごいです!生徒用時間割に反映されました!
    ありがとうございました。

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

ベストアンサー以外の回答

1〜1件/1件中

プロフィール画像

カテゴリマスター

aka********さん

2020/4/500:55:36

添付 参照
生徒用のシートも 縦に曜日であれば 添付のように簡単にできますが
いかがですか

色は 学年で分けても 列が違うので 不要かと
其れよりも クラスで 条件付き書式で 色を変えてみました。

Sheet1.Select
For J = 3 To Cells(3, Columns.Count).End(xlToLeft).Column
For I = 4 To Cells(Rows.Count, "B").End(xlUp).Row
If Cells(I, J) <> "" Then
Set Rng = Sheet2.Rows(3).Find(Cells(I, J))
Sheet2.Cells(I, Rng.Column) = Sheet1.Cells(3, J)
End If
Next
Next
Sheet2.Select

これで 試して 下さい。

添付 参照
生徒用のシートも 縦に曜日であれば 添付のように簡単にできますが
いかがですか

色は...

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

この質問につけられたタグ

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる