|
▼kees さん:
>こんばんは。はじめて投稿いたします。
>質問なのですが、個人別の時間割を作りたいのですが、まったくわからず
>困っています。自分でもいろいろ考えたのですが、VBAはほとんどわからないので
>行き詰まってしまいました。
>助けてください。よろしくお願いいたします。
>私のイメージでは、次のようなものを考えております。
>たとえば、Aさんが月曜日の1限、火曜の3限、金曜の2限、Bさんは火曜の
>2限、木曜の3限を担当していたとします。
>個人別の担当曜日と担当時間を入力すると、別シートに個人別の年間担当スケジュール
>が表示されるようにしたいと思っています。(個人ごとに別シートに表示)
>
>どなたか、駄目なできない私のお力をお貸しください。よろしくお願いいたします。
G-Luckといいます。
条件:
Sheet1に
名前 曜日 時限
A 月 1
A 火 3
A 金 2
B 火 2
B 木 3
・
・
・
としてデータがあるとします。
A、B・・・のシートは存在しない又は、存在しても"A2:H7"が空白である。
出力は、横に曜日(日〜土)、縦に時限(1〜6)該当枠には"○"、以外は空白
操作法
データをSheet1に書いて、ツール>マクロ>マクロから、時間割表作成を選択して実行をクリック
利用法
下記コードを、標準モジュールにコピーして下さい
'以下コード
Public Sub 時間割表作成()
'
Const Mark As String = "○"
Const YOUBIList As String = "日月火水木金土"
Dim rg As Range
Dim rgIn As Range
Dim i As Long
Dim n As Long
Dim SheetName As String
Dim YOUBI As Integer
Dim JIGEN As Integer
Dim myWS As Worksheet
n = DataCount
If n < 1 Then Exit Sub
Set rgIn = ThisWorkbook.Worksheets("Sheet1").Range("A2:C2")
For i = 1 To n
SheetName = rgIn.Cells(1)
YOUBI = InStr(YOUBIList, rgIn.Cells(2)) + 1
JIGEN = rgIn.Cells(3) + 1
On Error Resume Next
Set myWS = Worksheets(SheetName)
If Err <> 0 Then
Set myWS = Worksheets.Add _
(after:=Worksheets(Worksheets.Count))
myWS.Name = SheetName
Call WorksheetSet(myWS)
End If
On Error GoTo 0
myWS.Cells(JIGEN, YOUBI) = Mark
Set rgIn = rgIn.Offset(1, 0)
Next i
End Sub
Private Function DataCount() As Long
'元データー数
Dim n As Long
With ThisWorkbook.Worksheets("Sheet1")
If .Range("A2").Value = "" Then
n = 0
Else
n = .Range("A1").End(xlDown).Row - .Range("A1").Row
End If
End With
DataCount = n
End Function
Private Sub WorksheetSet(mySheet As Worksheet)
'Sheetの初期設定
Dim YOUBIList As Variant
Dim JIGENList(1 To 6, 1 To 1) As String
Dim i As Integer
YOUBIList = Array("", "日曜日", "月曜日", "火曜日", "水曜日", "木曜日", "金曜日", "土曜日")
For i = 1 To 6
JIGENList(i, 1) = i & "時限目"
Next i
With mySheet
.Cells.HorizontalAlignment = xlCenter
.Range("A1:H1") = YOUBIList
.Range("A2:A7") = JIGENList
End With
End Sub
|
|