Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


10289 / 13646 ツリー ←次へ | 前へ→

【22665】よろしくお願いいたします。 kees 05/2/26(土) 0:50 質問[未読]
【22667】Re:よろしくお願いいたします。 G-Luck 05/2/26(土) 3:10 回答[未読]
【22686】ありがとうございます。 kees 05/2/28(月) 9:29 お礼[未読]
【22687】Re:ありがとうございます。 G-Luck 05/2/28(月) 9:38 発言[未読]

【22665】よろしくお願いいたします。
質問  kees E-MAIL  - 05/2/26(土) 0:50 -

引用なし
パスワード
   こんばんは。はじめて投稿いたします。
質問なのですが、個人別の時間割を作りたいのですが、まったくわからず
困っています。自分でもいろいろ考えたのですが、VBAはほとんどわからないので
行き詰まってしまいました。
助けてください。よろしくお願いいたします。
私のイメージでは、次のようなものを考えております。
たとえば、Aさんが月曜日の1限、火曜の3限、金曜の2限、Bさんは火曜の
2限、木曜の3限を担当していたとします。
個人別の担当曜日と担当時間を入力すると、別シートに個人別の年間担当スケジュール
が表示されるようにしたいと思っています。(個人ごとに別シートに表示)

どなたか、駄目なできない私のお力をお貸しください。よろしくお願いいたします。

【22667】Re:よろしくお願いいたします。
回答  G-Luck  - 05/2/26(土) 3:10 -

引用なし
パスワード
   ▼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

【22686】ありがとうございます。
お礼  kees E-MAIL  - 05/2/28(月) 9:29 -

引用なし
パスワード
   G-Lock様
ありがとうございます。
すぐの回答にびっくり、感激いたしました。
本当に助かりました。

【22687】Re:ありがとうございます。
発言  G-Luck  - 05/2/28(月) 9:38 -

引用なし
パスワード
   ▼kees さん:
>G-Lock様
>ありがとうございます。
>すぐの回答にびっくり、感激いたしました。
>本当に助かりました。

G-L"u"ckなんですけど〜〜

10289 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free