忍者ブログ
日常だったりネタだったり作品の進捗だったり……色々書きます。不定期に。
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「演習-学生名簿」続き4

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

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

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

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



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


    ○使用変数
    Public Group(9) As Integer '1グループに割り振られた現在の人数
    Public Ninzu(9) As Integer '1グループの人数
    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 '


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

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


      ~~~~~~~ソース2.-ここから~~~~~~~~
    '============================================
    'グループ振り分け
    '============================================
    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
     ~~~~~~~ソース2.-ここまで~~~~~~~~

    ソース2でやってること→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以上あまっていることはないので変数kがひと回りするだけの
      単純なFor文でOKです。

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

     

     ~~~~~~~ソース3.-ここから~~~~~~~~
    '============================================
    'グループ順に並び替え-昇順
    '============================================
    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
    ~~~~~~~ソース3-ここまで~~~~~~~~

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



    ~~~~~~~ソース4-ここから~~~~~~~~
    (長いけど同じことしかやってないから一気に行きます)
    '============================================
    'グループごとに並べ替え
    '============================================
    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 = "グループ1"
              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 = "グループ2"
               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 = "グループ3"
               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 = "グループ4"
               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 = "グループ5"
              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 = "グループ6"
              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 = "グループ7"
              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 = "グループ8"
              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 = "グループ9"
              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 = "グループ10"
              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
    ~~~~~~~ソース4-ここまで~~~~~~~~

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

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

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


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

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


    結果はこうなります↓
    36ad0f2d.png









    (キャラクターはつっこんじゃいけないww!!)


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


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

     

    拍手[1回]

    PR

    お名前
    タイトル
    文字色
    URL
    コメント
    パスワード   Vodafone絵文字 i-mode絵文字 Ezweb絵文字
    非公開コメント
    この記事にトラックバックする:
    [398]  [397]  [396]  [395]  [394]  [393]  [392]  [391]  [390]  [389]  [388
    カレンダー
    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]