| |
▼kees さん：
>こんばんは。はじめて投稿いたします。
>質問なのですが、個人別の時間割を作りたいのですが、まったくわからず
>困っています。自分でもいろいろ考えたのですが、ＶＢＡはほとんどわからないので
>行き詰まってしまいました。
>助けてください。よろしくお願いいたします。
>私のイメージでは、次のようなものを考えております。
>たとえば、Ａさんが月曜日の1限、火曜の３限、金曜の２限、Ｂさんは火曜の
>２限、木曜の３限を担当していたとします。
>個人別の担当曜日と担当時間を入力すると、別シートに個人別の年間担当スケジュール
>が表示されるようにしたいと思っています。（個人ごとに別シートに表示）
>
>どなたか、駄目なできない私のお力をお貸しください。よろしくお願いいたします。
G-Luckといいます。
条件：
Sheet1に
名前 曜日 時限
Ａ 月 １
Ａ 火 ３
Ａ 金 ２
Ｂ 火 ２
Ｂ 木 ３
・
・
・
としてデータがあるとします。
Ａ、Ｂ・・・のシートは存在しない又は、存在しても"A2:H7"が空白である。
出力は、横に曜日（日〜土）、縦に時限(１〜６）該当枠には"○"、以外は空白
操作法
データを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
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
- 05/2/26(土) 0:50 -
