部活動の試合や練習で保護者の当番があります。当番も大変ですが、当番表を組む方も大変です。 試合や練習日の日によって当番する人数も違うかと思います。 予め月日ごとに行事スケジュールを決めて、その日によっては当番は一人から四人当たるとします。 必要な人数分を黄色のセルにしておきます。 保護者の一覧を右に並べておきます。 エクセルのその黄色のセル上に、保護者の方を一覧の順番に割り振っていく仕組みを作成しました。 同時に保護者の方も当番が何月何日か一目瞭然で判るようにしました。 ForループDo Unitl や配列を活用しています。
詳細は、youtube動画をご参照ください。
sheet1内Private Sub Worksheet_SelectionChange(ByVal Target As Range)のコード
|
1 2 3 4 5 6 7 8 9 10 11 12 13 |
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Row = 14 And Target.Column = 5 Then Range("E3:H13").Select Selection.ClearContents Range("K3:O13").Select Selection.ClearContents End If If Target.Row = 14 And Target.Column = 3 Then Call AAA End If End Sub |
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 |
Public Sub AAA() Dim i, j As Integer '番地 Dim number As Integer Dim max_number As Integer '配列 Dim kiiro_gyo(100) As Integer Dim kiiro_retsu(100) As Integer Dim kiiro_hiduke(100) As Date number = 1 For i = 3 To 13 For j = 5 To 8 If Cells(i, j).Interior.Color = RGB(255, 255, 0) Then Cells(i, j).Select Cells(i, j) = "名前" kiiro_gyo(number) = i kiiro_retsu(number) = j kiiro_hiduke(number) = Cells(i, 1) 'MsgBox (number & "番地で " & _ kiiro_gyo(number) & "行目で " & _ kiiro_retsu(number) & "列目で " & _ kiiro_hiduke(number) & "です") number = number + 1 End If Next j Next i max_number = number - 1 'MsgBox (max_number) Dim k As Integer Dim n As Integer k = 3 number = 1 Do Until number > max_number If Cells(k, 10) = "" Then k = 3 End If Cells(kiiro_gyo(number), kiiro_retsu(number)).Select '保護者名を転記 Cells(kiiro_gyo(number), kiiro_retsu(number)) = Cells(k, 10) '日付を転記 For n = 11 To 15 If Cells(k, n) = "" Then Cells(k, n) = kiiro_hiduke(number) Exit For End If Next n number = number + 1 k = k + 1 'MsgBox ("A") Loop End Sub |
