こんばんは若槻です。
1回タイトル入力した段階で記事をアップしてしまいました。
その状態を見てしまった方ごめんなさいΣ

では本日はVBAの続きといきます。

====================================================
◎システム名　「演習-学生名簿」
====================================================
～現在ある内容～
・グループ分け
・学年別　　←簡単１        ←終了
・学校別　　　　　　　　　　　←終了
・性別ごと　←簡単２　　　　←終了
・配役配置
・試合
・検索
・選抜
・動き
・条件別グループ分け（作成中

本日はグループ分けをおしゃべりします。



５．グループ分け
○やりたいこと
学生をランダムに10グループに分けます。
人数が増える分には対応できますが10人より人数が少なくなったら
アウトなソースですのであしからず（笑）!!


○使用変数
Public Group(9) As Integer '１グループに割り振られた現在の人数
Public Ninzu(9) As Integer '１グループの人数
Public Nin As Integer    '1グループの基本人数
Public Nin2 As Integer   'あまりの人数
Public Tuuka As Boolean  ’
Public Itiretume As Long　'
Public Niretume As Long　 '
Public Sanretume As Long　'
Public Yonretume As Long　'
Public GroupNo As Integer '


○ソース
～～～～～～～ソース１．-ここから～～～～～～～～
'============================================
'グループ関連
'============================================
Sub GroupKanren()
  DontLook
  SheetSet
 
  GroupFuriwake
  GroupSort
  GroupGoto
  WH3.Range("A1").Select
 
  OKLook
End Sub
～～～～～～～ソース１．-ここまで～～～～～～～～

ソース１でやっていること→各マクロの呼び出し


  ～～～～～～～ソース２．-ここから～～～～～～～～
'============================================
'グループ振り分け
'============================================
Sub GroupFuriwake()
[1]
  Erase Group, Ninzu
  Tuuka = False
  j = 0  'ランダム関数用
  k = 0  '人数用
  i = 2  '人数ループ用
  LG = WH1.Range("A65536").End(xlUp).Row - 1　'全体の人数

[2] 
  '◆◇◆10グループで人数を分ける－ここから◆◇◆
  Nin = Int(LG / 10)
  Nin2 = LG Mod 10
  For k = 0 To 9
    Ninzu(k) = Nin  '初期値の人数
  Next
 
  If Nin2 <> 0 Then
    For k = 0 To Nin2 - 1
      Ninzu(k) = Ninzu(k) + 1  '余った人数を入れていく
    Next
  End If
  '◆◇◆10グループで人数を分ける－ここまで◆◇◆
 
 
[3] 
  '◆◇◆グループ番号振り分け－ここから◆◇◆
  Do Until i > LG + 1
    Randomize
    j = Int(Rnd() * 10)
    Do Until Tuuka = True
      If Group(j) < Ninzu(j) Then
        Group(j) = Group(j) + 1
        WH1.Range("G" & i).Value = j + 1
        Tuuka = True
      Else 'If Group(j) > Ninzu(j) Then
        Randomize
        j = Int(Rnd() * 10)
      End If
    Loop
    Tuuka = False
    i = i + 1
  Loop
  '◆◇◆グループ番号振り分け－ここまで◆◇◆
End Sub
 ～～～～～～～ソース２．-ここまで～～～～～～～～

ソース２でやってること→1グループに入る人数を計算
[1]ここでは使う変数を初期化しています。
　目玉はこれですかね。

　「　Erase Group, Ninzu　」　
　
　これは配列変数を初期化するためのものです。
　「Erase」の後に初期化したい変数を入れればいちいち
　DoとかForとかで回す必要がなくなりますので覚えておくと
　便利ですよ！

[2]
　1.ソース中にも書いてありますが、ここで1グループの人数を決めます。
　　まずは全体の人数を10で割った値を変数Ninに入れます。
　　ここで「Int()」に入れると値を整数にしてくれるので、
　　整数の答えが欲しいときは使いましょう。
　　※ちなみにExcel関数の「Round」系も以前紹介した「WorksheetFunction」を
　　　使えば出来ますのでそっちがいい方はそちらをどうぞ。
　
　2.次の「Nin2 = LG Mod 10」では、変数Nin2に「LGを10で割ったあまり」を
　　代入しています。現在いる面々をひとりあまさずグループ内に
　　入れる場合は必ず求めなくちゃいけません。仲間はずれよくない。

　3.最初のFor文では配列変数に初期の人数を代入。
　　10グループと最初から分かっているので今回はRedimは使用しません。

　　そして、あまりがある場合(Nin2が0ではない)はNin2の分を
　　Forで回して追加していきます。
　　この時10以上あまっていることはないので変数ｋがひと回りするだけの
　　単純なFor文でOKです。

[3]ここではランダムでグループ番号を引っ張ってきて、上で割り当てられた
　　人数内の間はそこに1ずつプラスしていき、ｉ行目の学生のＧ列には
　　グループ番号を入力していきます。
　　全て回り終わったら変数TuukaをTrueにしてDoを抜けます。

 

 ～～～～～～～ソース３．-ここから～～～～～～～～
'============================================
'グループ順に並び替え－昇順
'============================================
Sub GroupSort()
  WH2.Cells.Delete
  SyokiCopy
 
  WH2.Select
  LG = WH2.Range("A65536").End(xlUp).Row
  WH2.Range("A2:G" & LG).Sort _
            Key1:=Range("G2"), order1:=xlAscending, _
            key2:=Range("F2"), order2:=xlDescending, _
            key3:=Range("B2"), order3:=xlAscending
           
   WH2.Range("A1").Select
End Sub
～～～～～～～ソース３-ここまで～～～～～～～～

ソース３でやってること→グループごとに並び替え



～～～～～～～ソース４-ここから～～～～～～～～
（長いけど同じことしかやってないから一気に行きます）
'============================================
'グループごとに並べ替え
'============================================
Sub GroupGoto()
[1]
  WH3.Cells.Delete

[2] 
  i = 2  '学生一覧
  j = 3  'グループ別
  Niretume = 0
  LG = WH2.Range("A65536").End(xlUp).Row
  Do Until i > LG
    Select Case WH2.Range("G" & i).Value
      Case 1
        If WH3.Range("A1").Value = "" Then
          WH3.Range("A1").Value = "グループ１"
          WH3.Range("A2").Value = "名前"
          WH3.Range("B2").Value = "学校名"
          WH3.Range("C2").Value = "学年"
          WH3.Range("D2").Value = "性別"
          WH3.Range("A1:D1").MergeCells = True
          WH3.Range("A1:D2").HorizontalAlignment = xlHAlignCenter
          WH3.Range("A2:D2").Borders(xlEdgeBottom).LineStyle = xlDouble
        End If
        WH3.Range("A" & j).Value = WH2.Range("B" & i).Value
        WH3.Range("B" & j).Value = WH2.Range("E" & i).Value
        WH3.Range("C" & j).Value = WH2.Range("F" & i).Value
        WH3.Range("D" & j).Value = WH2.Range("D" & i).Value
        j = j + 1
       
       Case 2
         If WH3.Range("E1").Value = "" Then
           Itiretume = j
           WH3.Range("E1").Value = "グループ２"
           WH3.Range("E2").Value = "名前"
           WH3.Range("F2").Value = "学校名"
           WH3.Range("G2").Value = "学年"
           WH3.Range("H2").Value = "性別"
           WH3.Range("E1:H1").MergeCells = True
           WH3.Range("E1:H2").HorizontalAlignment = xlHAlignCenter
           WH3.Range("E2:H2").Borders(xlEdgeBottom).LineStyle = xlDouble
           j = 3
         End If
         WH3.Range("E" & j).Value = WH2.Range("B" & i).Value
         WH3.Range("F" & j).Value = WH2.Range("E" & i).Value
         WH3.Range("G" & j).Value = WH2.Range("F" & i).Value
         WH3.Range("H" & j).Value = WH2.Range("D" & i).Value
         j = j + 1
      
       Case 3
         If WH3.Range("I1").Value = "" Then
           WH3.Range("I1").Value = "グループ３"
           WH3.Range("I2").Value = "名前"
           WH3.Range("J2").Value = "学校名"
           WH3.Range("K2").Value = "学年"
           WH3.Range("L2").Value = "性別"
           WH3.Range("I1:L1").MergeCells = True
           WH3.Range("I1:L2").HorizontalAlignment = xlHAlignCenter
           WH3.Range("I2:L2").Borders(xlEdgeBottom).LineStyle = xlDouble
           j = 3
         End If
         WH3.Range("I" & j).Value = WH2.Range("B" & i).Value
         WH3.Range("J" & j).Value = WH2.Range("E" & i).Value
         WH3.Range("K" & j).Value = WH2.Range("F" & i).Value
         WH3.Range("L" & j).Value = WH2.Range("D" & i).Value
         j = j + 1
      
       Case 4
         If WH3.Range("M1").Value = "" Then
           WH3.Range("M1").Value = "グループ４"
           WH3.Range("M2").Value = "名前"
           WH3.Range("N2").Value = "学校名"
           WH3.Range("O2").Value = "学年"
           WH3.Range("P2").Value = "性別"
           WH3.Range("M1:P1").MergeCells = True
           WH3.Range("M1:P2").HorizontalAlignment = xlHAlignCenter
           WH3.Range("M2:P2").Borders(xlEdgeBottom).LineStyle = xlDouble
           j = 3
         End If
         WH3.Range("M" & j).Value = WH2.Range("B" & i).Value
         WH3.Range("N" & j).Value = WH2.Range("E" & i).Value
         WH3.Range("O" & j).Value = WH2.Range("F" & i).Value
         WH3.Range("P" & j).Value = WH2.Range("D" & i).Value
         j = j + 1
      
      Case 5
        If WH3.Range("A" & Itiretume + 2).Value = "" Then
          LG2 = Itiretume + 2
          WH3.Range("A" & LG2).Value = "グループ５"
          WH3.Range("A" & LG2 + 1).Value = "名前"
          WH3.Range("B" & LG2 + 1).Value = "学校名"
          WH3.Range("C" & LG2 + 1).Value = "学年"
          WH3.Range("D" & LG2 + 1).Value = "性別"
          WH3.Range("A" & LG2 & ":D" & LG2).MergeCells = True
          WH3.Range("A" & LG2 & ":D" & LG2 + 1).HorizontalAlignment = xlHAlignCenter
          WH3.Range("A" & LG2 & ":D" & LG2 + 1).Borders(xlEdgeBottom).LineStyle = xlDouble
          j = LG2 + 2
        End If
        WH3.Range("A" & j).Value = WH2.Range("B" & i).Value
        WH3.Range("B" & j).Value = WH2.Range("E" & i).Value
        WH3.Range("C" & j).Value = WH2.Range("F" & i).Value
        WH3.Range("D" & j).Value = WH2.Range("D" & i).Value
        j = j + 1
      
      Case 6
        If Niretume = 0 Then
          Niretume = Itiretume
        End If
        If WH3.Range("E" & Niretume + 2).Value = "" Then
          Itiretume = j
          LG2 = Niretume + 2
          WH3.Range("E" & LG2).Value = "グループ６"
          WH3.Range("E" & LG2 + 1).Value = "名前"
          WH3.Range("F" & LG2 + 1).Value = "学校名"
          WH3.Range("G" & LG2 + 1).Value = "学年"
          WH3.Range("H" & LG2 + 1).Value = "性別"
          WH3.Range("E" & LG2 & ":H" & LG2).MergeCells = True
          WH3.Range("E" & LG2 & ":H" & LG2 + 1).HorizontalAlignment = xlHAlignCenter
          WH3.Range("E" & LG2 & ":H" & LG2 + 1).Borders(xlEdgeBottom).LineStyle = xlDouble
          j = LG2 + 2
        End If
        WH3.Range("E" & j).Value = WH2.Range("B" & i).Value
        WH3.Range("F" & j).Value = WH2.Range("E" & i).Value
        WH3.Range("G" & j).Value = WH2.Range("F" & i).Value
        WH3.Range("H" & j).Value = WH2.Range("D" & i).Value
        j = j + 1
      
      Case 7
        If WH3.Range("I" & Niretume + 2).Value = "" Then
          LG2 = Niretume + 2
          WH3.Range("I" & LG2).Value = "グループ７"
          WH3.Range("I" & LG2 + 1).Value = "名前"
          WH3.Range("J" & LG2 + 1).Value = "学校名"
          WH3.Range("K" & LG2 + 1).Value = "学年"
          WH3.Range("L" & LG2 + 1).Value = "性別"
          WH3.Range("I" & LG2 & ":L" & LG2).MergeCells = True
          WH3.Range("I" & LG2 & ":L" & LG2 + 1).HorizontalAlignment = xlHAlignCenter
          WH3.Range("I" & LG2 & ":L" & LG2 + 1).Borders(xlEdgeBottom).LineStyle = xlDouble
          j = LG2 + 2
        End If
        WH3.Range("I" & j).Value = WH2.Range("B" & i).Value
        WH3.Range("J" & j).Value = WH2.Range("E" & i).Value
        WH3.Range("K" & j).Value = WH2.Range("F" & i).Value
        WH3.Range("L" & j).Value = WH2.Range("D" & i).Value
        j = j + 1
      
      Case 8
        If WH3.Range("M" & Niretume + 2).Value = "" Then
          LG2 = Niretume + 2
          WH3.Range("M" & LG2).Value = "グループ８"
          WH3.Range("M" & LG2 + 1).Value = "名前"
          WH3.Range("N" & LG2 + 1).Value = "学校名"
          WH3.Range("O" & LG2 + 1).Value = "学年"
          WH3.Range("P" & LG2 + 1).Value = "性別"
          WH3.Range("M" & LG2 & ":P" & LG2).MergeCells = True
          WH3.Range("M" & LG2 & ":P" & LG2 + 1).HorizontalAlignment = xlHAlignCenter
          WH3.Range("M" & LG2 & ":P" & LG2 + 1).Borders(xlEdgeBottom).LineStyle = xlDouble
          j = LG2 + 2
        End If
        WH3.Range("M" & j).Value = WH2.Range("B" & i).Value
        WH3.Range("N" & j).Value = WH2.Range("E" & i).Value
        WH3.Range("O" & j).Value = WH2.Range("F" & i).Value
        WH3.Range("P" & j).Value = WH2.Range("D" & i).Value
        j = j + 1
      
      Case 9
        If WH3.Range("A" & Itiretume + 2).Value = "" Then
          LG2 = Itiretume + 2
          WH3.Range("A" & LG2).Value = "グループ９"
          WH3.Range("A" & LG2 + 1).Value = "名前"
          WH3.Range("B" & LG2 + 1).Value = "学校名"
          WH3.Range("C" & LG2 + 1).Value = "学年"
          WH3.Range("D" & LG2 + 1).Value = "性別"
          WH3.Range("A" & LG2 & ":D" & LG2).MergeCells = True
          WH3.Range("A" & LG2 & ":D" & LG2 + 1).HorizontalAlignment = xlHAlignCenter
          WH3.Range("A" & LG2 & ":D" & LG2 + 1).Borders(xlEdgeBottom).LineStyle = xlDouble
          j = LG2 + 2
        End If
        WH3.Range("A" & j).Value = WH2.Range("B" & i).Value
        WH3.Range("B" & j).Value = WH2.Range("E" & i).Value
        WH3.Range("C" & j).Value = WH2.Range("F" & i).Value
        WH3.Range("D" & j).Value = WH2.Range("D" & i).Value
        j = j + 1
      
      Case 10
        If WH3.Range("E" & Itiretume + 2).Value = "" Then
          LG2 = Itiretume + 2
          WH3.Range("E" & LG2).Value = "グループ１０"
          WH3.Range("E" & LG2 + 1).Value = "名前"
          WH3.Range("F" & LG2 + 1).Value = "学校名"
          WH3.Range("G" & LG2 + 1).Value = "学年"
          WH3.Range("H" & LG2 + 1).Value = "性別"
          WH3.Range("E" & LG2 & ":H" & LG2).MergeCells = True
          WH3.Range("E" & LG2 & ":H" & LG2 + 1).HorizontalAlignment = xlHAlignCenter
          WH3.Range("E" & LG2 & ":H" & LG2 + 1).Borders(xlEdgeBottom).LineStyle = xlDouble
          j = LG2 + 2
        End If
        WH3.Range("E" & j).Value = WH2.Range("B" & i).Value
        WH3.Range("F" & j).Value = WH2.Range("E" & i).Value
        WH3.Range("G" & j).Value = WH2.Range("F" & i).Value
        WH3.Range("H" & j).Value = WH2.Range("D" & i).Value
        j = j + 1
    End Select
    i = i + 1
  Loop
    
 [3] 
  '列幅のオートフィット
  LG = WH3.UsedRange.Columns.Count
  For i = 1 To LG
    WH3.Rows(i).EntireColumn.AutoFit
  Next
 
  '罫線
   LG = WH3.Range("A65536").End(xlUp).Row + 1
   LR = WH3.UsedRange.Columns.Count
  
   For i = Niretume To Itiretume Step Niretume + 1
     WH3.Range("A" & i & ":P" & i).Borders(xlEdgeBottom).LineStyle = xlDashDot
   Next
  
   WH3.Range("A" & LG & ":P" & LG).Borders(xlEdgeBottom).LineStyle = xlDashDot
  
   For i = 4 To LR Step 4
     WH3.Select
     WH3.Range(Cells(1, i), Cells(LG, i)).Borders(xlEdgeRight).Weight = xlMedium
   Next
  WH3.Range("A1").Select
End Sub
～～～～～～～ソース４-ここまで～～～～～～～～

ソース４でやってること→グループごとに人を並べる
[1]グループ一覧を出すシートをクリアする

[2]グループ順に並び替えた学生一覧を上から見ていき、
　　G列の値ごとに「Select Case」で判断していく。
　　ちなみに４グループが横に並んだら折り返されるので
　　1-4,5-8,9-10の並び方。

　　※プログラムの性質上1グループ目が一番人数が多くなるので、この最終列が
　　　1-4までのグループの最大行になります。
　　　なので、変数Itiretumeには一列目のグループの最終行が入ります。
　　　同じ要領で変数Niretumeには二列目のグループの最終行が入ります。
　　　あとはひたすら学生情報を入れていくだけですね。

　　今考えるともう少しマシなプログラムを組めそうな気がしますけど、
　　まあ気にしない方向で。

[3]最終処理をしています。
　　1.名前やらの長さが色々変わるので各列でオートフィット
　　2.各最終行にダッシュドットの罫線を引く
　　（変数が2→1なので分かりづらいかも知れませんがグループ6の時に
　　　NiretumeにItiretumeの値を入れているので）
　　3.最終行にダッシュドットの罫線を引く
　　4.各グループの右側に中太の罫線を引く


結果はこうなります↓










（キャラクターはつっこんじゃいけないｗｗ!!）


それでは今回はここまでで。
お疲れ様でした！

※ちょっとした小技※
○Redimの使い方
　・「Redim　配列変数A(値)」
　　　→それまでAに入っていた値をクリアして宣言しなおす
　・「Redim　Preserve　配列変数A(値)」
　　　→それまでAに入っていた値を保持したまま宣言しなおす
　
　＝上のやり方だと前の値が消えて、下のやり方だと元の値の
　　後ろあたりにデータが入れられるようになる