忍者ブログ
日常だったりネタだったり作品の進捗だったり……色々書きます。不定期に。
09
  • 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
  • 管理画面

    VBA「演習-学生名簿」続き6

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


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



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

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

     

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


    ○使用変数
    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 


    ○ソース
    ~~~~~~~ソース1.-ここから~~~~~~~~
    '================================================
    '試合配置
    '================================================
    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.-ここまで~~~~~~~~

    ソース1でやってること→メイン動作。各マクロの呼び出し
    [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.ウィンドウ枠を固定

     

    ~~~~~~~~ソース2.-ここから~~~~~~~~
    '==================================================
    '性別【女子】の行を消す
    '==================================================
    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
    ~~~~~~~~ソース2.-ここまで~~~~~~~~

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

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

     


    ~~~~~~~~ソース3.-ここから~~~~~~~~
    '=============================================
    '対戦-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
    ~~~~~~~~ソース3.-ここまで~~~~~~~~

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

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

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

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


    ~~~~~~~~ソース4.-ここから~~~~~~~~
    '=============================================
    '対戦-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
    ~~~~~~~~ソース4.-ここまで~~~~~~~~

    ソース4でやってること→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」の場合は
      変数iが3から始まりLGまで2行おきに処理がされます。
      

    ~~~~~~~~ソース5.-ここから~~~~~~~~
    '==========================================
    '余分な人数分をあまりスペースに格納
    '==========================================
    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
    ~~~~~~~~ソース5.-ここまで~~~~~~~~

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


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

    5434a95f.JPG




















    02c08578.JPG














    [1]組み合わせ:混合、人数:2人、学年:1年・2年
    f736c9f4.JPG




















    05168810.JPG












    [2]組み合わせ:女子、人数:1人、学年:1年
    68fecf92.JPG




















    7e7302c9.JPG














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

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


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

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


    ~~~~~~~~ソース8.-ここから~~~~~~~~
    '========================================
    '組み合わせ
    '=========================================
    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
    ~~~~~~~~ソース8.-ここまで~~~~~~~~

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


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

    [2] 
      NaiyouKakunou

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

    ソース9でやっていること→人数条件を選択
    [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に条件に合った値を入れる
     混合:0、1年:1、2年:2、3年:3、
     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にリストの値を移す
     ・現在入っているリストの内容をiの値が一致する
      配列変数Naiyouに格納していく
     ・格納後リストをクリア(これをしないと前のものの続きに
      データが入ってしまう)
      ※リストボックスへの「Add Item」で上書きは出来ません

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


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

     

    拍手[0回]

    PR

    お名前
    タイトル
    文字色
    URL
    コメント
    パスワード   Vodafone絵文字 i-mode絵文字 Ezweb絵文字
    非公開コメント
    この記事にトラックバックする:
    [462]  [461]  [460]  [459]  [458]  [457]  [456]  [455]  [454]  [453]  [451
    カレンダー
    08 2019/09 10
    S M T W T F S
    1 2 3 4 5 6
    8 9 10 11 12 13 14
    15 16 17 18 19 20 21
    22 23 24 25 26 27 28
    29 30
    ブログ内検索
    最新コメント
    [05/27 きり]
    [01/13 きり]
    [06/06 わんこ]
    [03/30 サイトウ]
    [06/09 yu]
    カウンター
    アクセス解析


    フリーエリア
    コガネモチ


        ◆ graphics by アンの小箱 ◆ designed by Anne ◆

        忍者ブログ [PR]