こんばんは若槻です。以前TOUYAさんに回していただいたバトンの
下書きをしていました。とうまくんから匙投げられたからこれを
4,000Hitのお礼絵に転用しようと画策中←


さて、本日は連続になりますがVBAのおしゃべりです。
需要がなかろうとしっちゃこっちゃありません（笑



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

本日は試合をおしゃべりします。

 

７．試合
○やりたいこと
試合といってもやるのは組み合わせを作るだけです。
キャラクターに何かしら値を持たせれば試合まで行うのも可能ですかね。
ですが今回はユーザーフォームで指定した条件ごとに
組み分けをする、というところまでになります。

○使用変数
Public Kumiawase As String
Public Gakunen As Integer
Public Kaisuu As String      

'ユーザーフォーム用
Public ListCNT As Integer  
Public Naiyou(2) As String
Public Kakuho As Integer 

○ソース
～～～～～～～ソース１．-ここから～～～～～～～～
'================================================
'試合配置
'================================================
Sub SiaiHaiti()
  SheetSet
  DontLook

[1] 
  '=============ウィンドウ枠の解除
  ActiveWindow.FreezePanes = False
 
[2]
  '====================WH8のデータの削除
  LG = WH8.Range("A65536").End(xlUp).Row
  If LG > 1 Then
    WH8.Range("A2:O" & LG).Delete
  End If
 
[3]
  '=====WH2にWH1のデータをコピーして並び替え===========
  SyokiCopy
 
[4] 
  'ユーザーフォームの読み出し
  UserForm1.Show

[5] 
  '==========組み合わせ==========
  Select Case True
    Case Kumiawase = "男子"
      OutGirl
    Case Kumiawase = "女子"
      OutBoy
  End Select
 
  '学年
  Select Case True
    Case Gakunen = 1
      OutOtherFirst
    Case Gakunen = 2
      OutOtherSecond
    Case Gakunen = 3
      OutOtherThird
    Case Gakunen = 12
      OutThird
    Case Gakunen = 13
      OutSecond
    Case Gakunen = 23
      OutFirst
  End Select
 
  '人数ごとに振り分け
  Select Case Nin
    Case 1
      OneOnOne
    Case 2
      MixDouble
  End Select
 
[6] 
  '行の高さ変更
  WH8.Range("1:" & LG).RowHeight = 22.5
 
  '罫線
  With WH8.Range("A1:I" & LG)
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Borders(xlEdgeTop).LineStyle = xlContinuous
    .Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Borders(xlEdgeRight).LineStyle = xlContinuous
  End With
 
 
  '背景色
  WH8.Range("A1:I" & LG).Interior.ColorIndex = 2
 
  '全体を中央寄せ
  WH8.Range("A:I").HorizontalAlignment = xlCenter
 
  WH8.Select
  'ウィンドウ枠の固定
  WH8.Range("2:2").Select
  ActiveWindow.FreezePanes = True
  WH8.Range("J2").Select
  OKLook
End Sub

 ～～～～～～～ソース１．-ここまで～～～～～～～～

ソース１でやってること→メイン動作。各マクロの呼び出し
[1]ウィンドウ枠固定の解除
　→何回か前にも書いたかもしれませんが、これはやっておかないと
　　最終のウィンドウ枠固定がうまく機能しなくなってしまいます。

[2]A列の2行目からO列のLG（最終行）目までをデリート
[3]学生一覧のデータを作業用のシート「並べ替え」にコピー
[4]ユーザーフォームの呼び出し
　→ユーザーフォーム自体のコードは下で喋りますのでここでは
　　「呼び出しましたよ」ってことだけお伝えします。
　※ちなみにここでは「組み合わせ」「人数」「学年」を選択し、
　　その結果ごとに以降の行動が決まります。

[5]ユーザーフォーで選択した値によって行を選抜していく
　「組み合わせ」→「混合」：何もしない
　　　　　　　　　「男子」：OutGirl = 女子の行を削除
　　　　　　　　　「女子」：OutBoy　= 男子の行を削除
　　　　　　　　
　「学年」　　　→「全学年」　：何もしない
　　　　　　　　　「1年と2年」：OutThird = 3年の行を削除
　　　　　　　　　「1年と3年」：OutSecond = 2年の行を削除
　　　　　　　　　「2年と3年」：OutFirst = 1年の行を削除
　　　　　　　　　「1年」 　　：OutOtherFirst = 1年以外を削除
　　　　　　　　　「2年」 　　：OutOtherSecond = 2年以外を削除
　　　　　　　　　「3年」　 　：OutOtherThird = 3年以外を削除
　　　　　　　　
　「人数」　　　→「1人」：1対1の組み合わせを作る
　　　　　　　　　「2人」：2対2の組み合わせを作る

[6]最終処理
　1.行の高さの変更
　　◎行の高さと列の幅◎
　　.RowHeight = 数字　　←行の高さは「ポイント」で表されています
　　.ColumnWidth = 数字　←列の幅は「標準フォントで何文字分の幅」で表されます
　　　　　　　　　　　　　いまいち分かりづらいので若槻は列幅を決めるときは
　　　　　　　　　　　　　一回現在の列幅を出してから調整してます。
　　　　　　　　　　　　　分かる人なら多分すぐに分かるかと！
　　※標準フォント=「ツール」→「オプション」→「全般タブ」で見られます
　　
　2.罫線を引く
　3.データが入ったところにだけ背景色を白にする
　4.全体を中央寄せ
　5.ウィンドウ枠を固定

 

～～～～～～～～ソース２．-ここから～～～～～～～～
'==================================================
'性別【女子】の行を消す
'==================================================
Sub OutGirl()
  LG = WH2.Range("A65536").End(xlUp).Row
  k = 2
  Do Until k > LG
    If WH2.Range("D" & k).Value = "女" Then
      WH2.Range(k & ":" & k).Delete
      k = k - 1
    End If
    k = k + 1
  Loop
End Sub
～～～～～～～～ソース２．-ここまで～～～～～～～～

ソース２でやってること→性別が「女」の行を削除する
　△最終行を求め、Do Loopを回して1行ずつ見ていきます。
　　一致した行は消し、1行分が減ったので変数ｋからも
　　1を引きます。
　　※前にも書きましたが、ここで1を減らさないと
　　　消した分だけ見ている行がずれていってしまい、
　　　最終的に消えるべき行が生き残ってしまいます。

　☆以下に
　　　・OutBoy
　　　・OutOtherFirst
　　　・OutOtherSecond
　　　・OutOtherThird
　　　・OutFirst
　　　・OutSecond
　　　・OutThird
　　が続きますが、やっていることはOutGirlと同じなので省略します。

 

～～～～～～～～ソース３．-ここから～～～～～～～～
'=============================================
'対戦-1対1
'=============================================
Sub OneOnOne()
[1]
  '=====全体の人数が奇数だった時に偶数に調整
  LG = WH2.Range("A65536").End(xlUp).Row
  If LG Mod 2 = 1 Then
    LG2 = LG - 1
    Kaisuu = Int(LG2 / 2)
  Else
    Kaisuu = Int(LG / 2)
  End If

[2]
  YobunIdou

[3]
  Ramdam
　
  j = 2  'WH8－行用
  h = 1  'WH8－列用
  Do Until j > Kaisuu
    Select Case h Mod 2
      Case 1
        WH8.Range("A" & j).Value = WH2.Range("B" & i).Value
        WH8.Range("B" & j).Value = WH2.Range("E" & i).Value
        WH8.Range("C" & j).Value = WH2.Range("F" & i).Value
        WH8.Range("D" & j).Value = WH2.Range("D" & i).Value
        h = h + 1
      Case 0
        WH8.Range("F" & j).Value = WH2.Range("B" & i).Value
        WH8.Range("G" & j).Value = WH2.Range("E" & i).Value
        WH8.Range("H" & j).Value = WH2.Range("F" & i).Value
        WH8.Range("I" & j).Value = WH2.Range("D" & i).Value
        j = j + 1
        h = h + 1
    End Select
    WH2.Range(i & ":" & i).Delete
    LG = WH2.Range("A65536").End(xlUp).Row
    If LG > 2 Then
      Ramdam
    ElseIf LG <> 1 Then
      i = LG
    Else
      Exit Do
    End If
  Loop
 
[4] 
  '列幅のオートフィット
  For i = 1 To 11
    WH8.Rows(i).EntireColumn.AutoFit
  Next
 
  'E列に"VS"入力して幅を変更
  LG = WH8.Range("A65536").End(xlUp).Row
  WH8.Range("E2:E" & LG).Value = "VS"
  WH8.Range("E:E").ColumnWidth = 20
 
 
  '1行ごとに罫線
  For i = 2 To LG
    WH8.Range("A" & i & ":I" & i).Borders(xlEdgeBottom).LineStyle = xlContinuous
  Next
End Sub
～～～～～～～～ソース３．-ここまで～～～～～～～～

ソース３でやってること→1対1の組み合わせを作る
[1]まずはLGに最終行を求めます。
　※この段階のLGの値は「全体」と「項目行」なので全体数より１多い

　次に、そのLGを2で割ったあまりを求めます（modは除算のあまりを求める）
　※ここで2で割っているのは、試合で１対１をやる場合１ゲームに
　「2人」が必要となるからです。

　その次に２で割っているのはループを回す数を求めるためです。
　
[2]YobunIdouを実行（後述）
[3]Kaisuuに格納された数の分だけループを回す
　1.列用の変数ｈの値が奇数の時は左の列に、偶数の時は右の列に
　　データを格納します
　2.ｉ列目のデータは格納されたら削除します
　3.残された行数（人数）が少なくなってきたらｉの値は最終行

[4]1.列幅のオートフィット
　2.互いの間に「ＶＳ」と入れ、列幅を20にする
　3.罫線を引く

～～～～～～～～ソース４．-ここから～～～～～～～～
'=============================================
'対戦-2対2
'=============================================
Sub MixDouble()
[1]
  '=====全体の人数が奇数だった時に偶数に調整
  LG = WH2.Range("A65536").End(xlUp).Row
  If LG Mod 2 = 1 Then
    LG2 = LG - 1
    Kaisuu = (LG2 / 2) + 1
  End If

[2]
  YobunIdou
 
[3]
  Ramdam
 
  j = 2  'WH8－行用
  h = 1  'WH8－列用
  Do Until j > Kaisuu
    Select Case h Mod 2
      Case 1
        WH8.Range("A" & j).Value = WH2.Range("B" & i).Value
        WH8.Range("B" & j).Value = WH2.Range("E" & i).Value
        WH8.Range("C" & j).Value = WH2.Range("F" & i).Value
        WH8.Range("D" & j).Value = WH2.Range("D" & i).Value
        h = h + 1
      Case 0
        WH8.Range("F" & j).Value = WH2.Range("B" & i).Value
        WH8.Range("G" & j).Value = WH2.Range("E" & i).Value
        WH8.Range("H" & j).Value = WH2.Range("F" & i).Value
        WH8.Range("I" & j).Value = WH2.Range("D" & i).Value
        j = j + 1
        h = h + 1
    End Select
    WH2.Range(i & ":" & i).Delete
   
    LG = WH2.Range("A65536").End(xlUp).Row
    If LG > 2 Then
      Ramdam
    ElseIf LG <> 1 Then
      i = LG
    Else
      Exit Do
    End If
  Loop
 
[4] 
  '列幅のオートフィット
  For i = 1 To 11
    WH8.Rows(i).EntireColumn.AutoFit
  Next
 
  'E列に"VS"入力して幅を変更
  LG = WH8.Range("A65536").End(xlUp).Row
  For i = 2 To LG Step 2
    WH8.Range("E" & i).Value = "VS"
    WH8.Range("E" & i & ":E" & i + 1).MergeCells = True
  Next
  WH8.Range("E:E").ColumnWidth = 20
 
 
  '1行ごとに罫線
  For i = 3 To LG Step 2
    WH8.Range("A" & i & ":I" & i).Borders(xlEdgeBottom).Weight = xlMedium
  Next
End Sub
～～～～～～～～ソース４．-ここまで～～～～～～～～

ソース４でやってること→2対2の組み合わせを作る
[1]～[3]OneOnOneでやっていることと同じなので割愛
[4]1.列幅のオートフィット
　2.「2行ごと」に「VS」の値を入れてセルを結合し、列幅を20にする
　3.「2行ごと」に罫線を引く
　
　※「Step △」
　　For文を書く時に、1行ずつの処理をしたい場合は何も書かなければ
　　いいのですが、2行ごとや3行ごとなど飛ばし飛ばしの処理をしたい場合は
　　「For 変数 = 始まりの数 To 終わりの数 Step 処理をしたい数」
　　とする。

　  今回の「For i = 3 To LG Step 2」の場合は
　　変数ｉが3から始まりLGまで2行おきに処理がされます。
　　

～～～～～～～～ソース５．-ここから～～～～～～～～
'==========================================
'余分な人数分をあまりスペースに格納
'==========================================
Sub YobunIdou()
  Ramdam
  LG = WH2.Range("A65536").End(xlUp).Row - 1
 
  Select Case Nin
    Case 1
      l = LG Mod 2
    Case 2
      l = LG Mod 4
  End Select
 
  k = 2
  If l > 0 And LG > 1 Then
    Do Until l = 0
      WH8.Range("K" & k).Value = WH2.Range("B" & l + 1).Value
      WH8.Range("L" & k).Value = WH2.Range("E" & l + 1).Value
      WH8.Range("M" & k).Value = WH2.Range("F" & l + 1).Value
      WH8.Range("N" & k).Value = WH2.Range("D" & l + 1).Value
      WH2.Range(l + 1 & ":" & l + 1).Delete
      k = k + 1
      l = l - 1
    Loop
  End If
End Sub
～～～～～～～～ソース５．-ここまで～～～～～～～～

ソース５でやってること→あまりになる人数分メンバーを抜き出す
・人数を求め、その最終行を2、または4で割る
　※割る値は試合人数によって変わる
・試合人数が2人：あまりがある場合は最大1人
・試合人数が4人：あまりがある場合は最大3人
・最大人数を各数で割ったあまりの値の分ループさせ、
　シート「試合」のあまりスペースに代入していき、
　終了後はその行を削除する

以下が条件別のユーザーフォームとその結果です
[0]デフォルト





































[1]組み合わせ：混合、人数：2人、学年：1年･2年


































[2]組み合わせ：女子、人数：1人、学年：1年




































ここからはユーザーフォームの中のソースです
～～～～～～～～ソース６．-ここから～～～～～～～～
'===================================
'フォームを読み込む時に初期化
'===================================
Private Sub UserForm_Initialize()
  Me.OP混合.Value = True
  Me.OB全学年.Value = True
  Me.OB1人.Value = True
 
  With Me.ListBox1
    .AddItem "組み合わせ：混合"
    .AddItem "人数：１人"
    .AddItem "学年：全学年 "
  End With
End Sub
～～～～～～～～ソース６．-ここまで～～～～～～～～

ソース６でやっていること→初期化
・ユーザーフォームを読み込んだ時の処理です。
　「UserForm_Initialize」はユーザーフォームの処理で
　一番早くに実行されます
・ここでは組み合わせ、学年、人数のオプションに初期の値を入れ、
　リストボックスに現在の条件を格納

～～～～～～～～ソース７．-ここから～～～～～～～～
'===================================================
'開始ボタンを押した時
'===================================================
Private Sub CB開始_Click()
  Unload Me
End Sub
～～～～～～～～ソース７．-ここまで～～～～～～～～

ソース７でやっていること→ユーザーフォームを閉じる

～～～～～～～～ソース８．-ここから～～～～～～～～
'========================================
'組み合わせ
'=========================================
Private Sub OP混合_Click()
[1]
  ListCNT = Me.ListBox1.ListCount - 1
  i = 0
 
[2]
  NaiyouKakunou
 
[3]
  Naiyou(0) = "組み合わせ：混合"
  i = 0
  Do Until i > ListCNT
    Me.ListBox1.AddItem Naiyou(i)
    i = i + 1
  Loop
  Kumiawase = "混合"
End Sub
～～～～～～～～ソース８．-ここまで～～～～～～～～

ソース８でやっていること→組み合わせ条件を選択
[1]リストボックスの行数(-1)を求める
　　※リストボックス内の配列を扱うための値なので1を引く
　　　Ex)行数が1→配列は0
　　　　 行数が2→配列は0と1
[2]マクロNaiyouKakunouの呼び出し（後述）
[3]・変数Naiyou(0)に条件文を格納
　　※"組み合わせ："までは同一、以降は混合･男子･女子と変わる
　・リストボックスに条件の格納
　・変数Kumiawaseに条件を格納(混合、男子、女子のいずれか)
　
　☆以下に
　　　・OB男子_Click
　　　・OB女子_Click
　　が続くが、やっていることは同じなので割愛

～～～～～～～～ソース９．-ここから～～～～～～～～
'========================================
'人数
'=========================================
Private Sub OB1人_Click()
[1]
  ListCNT = Me.ListBox1.ListCount - 1
  i = 0

[2] 
  NaiyouKakunou

[3] 
  Naiyou(1) = "人数：１人"
  i = 0
  Do Until i > ListCNT
    Me.ListBox1.AddItem Naiyou(i)
    i = i + 1
  Loop
  Nin = 1
End Sub
～～～～～～～～ソース９．-ここまで～～～～～～～～

ソース９でやっていること→人数条件を選択
[1]～[3]やっていることは大体同じ
[3]変数Ninに指定人数を格納（1人:1、2人：2）

・変数Naiyou(0)に条件文を格納
　　※"組み合わせ："までは同一、以降は混合･男子･女子と変わる
　・リストボックスに条件の格納
　・変数Kumiawaseに条件を格納(混合、男子、女子のいずれか)
　
　☆以下に
　　　・OB2人_Click
　　が続くが、やっていることは同じなので割愛

～～～～～～～～ソース10．-ここから～～～～～～～～
'========================================
'学年
'=========================================
Private Sub OB全学年_Click()
[1]
  ListCNT = Me.ListBox1.ListCount - 1
  i = 0

[2]
  NaiyouKakunou

[3]
  Naiyou(2) = "学年：全学年"
  i = 0
  Do Until i > ListCNT
    Me.ListBox1.AddItem Naiyou(i)
    i = i + 1
  Loop
  Gakunen = 0
End Sub
～～～～～～～～ソース10．-ここまで～～～～～～～～

ソース10でやっていること→学年条件を選択
[1]～[3]やっていることは大体同じ
[3]変数Gakunenに条件に合った値を入れる
　混合：０、１年：１、２年：２、３年：３、
　1･2年：12、1･3年：13、2･3年：23

　☆以下に
　　　・OB1年_Click
　　　・OB2年_Click
　　　・OB3年_Click
　　　・OB1年2年_Click
　　　・OB1年3年_Click
　　　・OB2年と3年_Click
　　が続くが、やっていることは同じなので割愛

～～～～～～～～ソース11．-ここから～～～～～～～～
'===================================
'内容を変数に入れておく
'===================================
Sub NaiyouKakunou()
  Do Until i > ListCNT
    Naiyou(i) = Me.ListBox1.List(i, 0)
    i = i + 1
  Loop
 
  Me.ListBox1.Clear
End Sub
～～～～～～～～ソース11．-ここまで～～～～～～～～

ソース11でやっていること→変数Naiyouにリストの値を移す
　・現在入っているリストの内容をｉの値が一致する
　　配列変数Naiyouに格納していく
　・格納後リストをクリア（これをしないと前のものの続きに
　　データが入ってしまう）
　　※リストボックスへの「Add Item」で上書きは出来ません

　△「ListBox.List(行番号、列番号)」
　　リストボックスの値を指定する場合おそらく一番簡単な方法。
　　列数を指定していない場合、列数は必ず1列なので、
　　配列的な考えで行くと「０」になります。
　　行番号も同様の考え方をするので、1列目・3行目のデータを
　　選ぶときは、
　　「ListBox.List(2,0)」
　　となります。

以上で「試合」は終了です。
ではお疲れ様でした～。