こんばんは若槻です。やっぱり今日もあんまり仕事なかったです。
ただ、今日はいつもの別課の課長から修正依頼来たし
総務の人の「フォントが反映されないから直して」っていうのも
来たので昨日よりは？

ちなみに総務の人の話は単純にExcel起動した後にフォントを
入れたから反映されてなかっただけでした（笑
↑気付くのに結構かかったとかね


さて、本日は久しぶりにVBAのおしゃべりです。
正直今作ってる奴の方が実用的なんですが、始めちゃったから
続けようかと！

※ちなみに会社で暇な時間に書いたものをコピペしただけなので
何かおかしなところがあったら華麗にスルーしてください（－ｖ－；）


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

本日は配役配置をおしゃべりします。

 

６．配役配置
○やりたいこと
最初に決めた配役に人物を当てはめる。
※配役等の項目名はシートに入りっぱなしなので、
　そこに個別に入れていくソース。

※完成すればランダムに割り当てられるので楽しいけど
　作る時にはちまちましたプログラムになっています

 

○ソース
　～～～～～～～ソース１．-ここから～～～～～～～～
'======================================================
'配役配置
'======================================================
Sub HaiyakuHaiti()
  SheetSet
  DontLook
 
  '=====WH2にWH1のデータをコピーして並び替え－ここから===========
  SyokiCopy
 
  Ramdam
  '=====WH2にWH1のデータをコピーして並び替え－ここまで===========
　～～～～～～～ソース１．-ここまで～～～～～～～～ 

ソース１でやっていること→各マクロの呼び出し
　・シートセット
　・画面のちらつきをなくす
　・学生一覧から並び替え用のシートにデータをコピー
　・ランダムで値を抜き出し（後述）

 

  ～～～～～～～ソース２．-ここから～～～～～～～～
（長いですがほぼ同一のコードなので最初と最後だけ出します）
  'シンデレラ配置
  j = 3  ' WH7(配役配置)用
  Do Until j > 10
    Retu = "B"
    KakusyoHaiti
    j = j + 1
  Loop
 
　　・
　　・
　　・

  '七騎士物語配置
  Ramdam
  j = 84  ' WH7(配役配置)用
  Do Until j > 98
    Retu = "P"
    KakusyoHaiti
    j = j + 1
  Loop
 
  ～～～～～～～ソース２．-ここまで～～～～～～～～
 
ソース２でやっていること→各所の配役に人を配置していく
　（変わっている点）　
  　・変数ｊとRetuの値（マクロ「KakusyoHaiti」で使用）

 
  ～～～～～～～ソース３．-ここから～～～～～～～～
  WH7.Select
 
 '列幅のオートフィット
  For i = 1 To 20
    WH7.Rows(i).EntireColumn.AutoFit
  Next

  WH7.Range("A1").Select
  OKLook
End Sub
  ～～～～～～～ソース３．-ここまで～～～～～～～～

ソース３でやっていること→列のオートフィットと画面のちらつきオン

  ～～～～～～～ソース４．-ここから～～～～～～～～
'=====================
'ランダム
'=====================
Sub Ramdam()
  WH2.Select
[1]
  LG = WH2.Range("A65536").End(xlUp).Row
  WH2.Range("I2:I" & LG).Value = "=Rand()"
  WH2.Range("A2:I" & LG).Sort Key1:=Range("I2"), order1:=xlAscending
  WH2.Range("A1").Select

[2]
  Randomize
  i = Int(Rnd() * LG) + 2 'WH2を回す用
  If LG <> 1 Then
    If i > LG Then
      Do Until i < LG
        Randomize
        i = Int(Rnd() * LG) + 2
      Loop
    End If
  End If
End Sub
  ～～～～～～～ソース４．-ここまで～～～～～～～～

ソース４でやっていること→ランダムに回してｉの値を引っ張る
[1]シート「並び替え」に入っている全ての行のI列に「=Rand()」を入れていきます。
　　「=Rand()」はエクセル自体で使えるランダム関数です。
　　なのでこれを格納するとその時点で0.いくつの値がI列に入ってきます。

　　そしてそれを昇順に並び替え――――といっても、その通りに
　　なることを期待してはいけません。何故ってこの並べ替えをした時点で
　　I列の値はまた変わっているから。
　　※Randはシート上で変更があるたびに値を変えます

　　じゃあなんで並べ替えてるかって言うと、単純にどこに誰がいるのか
　　分からなくするためです。
　　これをやることで次の動作の結果が非常に分かり辛くなります。

[2]色々やっているように見えますが並び替えのシートの何行目を
　抜き出すかを決めているだけですね。
　今回はシートの1行目が項目名であることを踏まえ、0と1を避けるために
　iに+2しています。
　1)If LG <> 1 Then　→　LGが1じゃない。状態的にならないはずですが一応
　2)If i > LG Then　→　iの値がLGよりも大きかったら決めなおし
　　※LG = 最終行なので、最終行を超えてはいけない
　
※マクロ名が正しい英語になっていないことにつっこんではいけませんΣ

 

  ～～～～～～～ソース５．-ここから～～～～～～～～
'=====================
'各所配置
'=====================
Sub KakusyoHaiti()
[1]
  Select Case Retu
    Case "B"
      WH7.Range("B" & j).Value = WH2.Range("B" & i).Value
      WH7.Range("C" & j).Value = WH2.Range("C" & i).Value
      WH7.Range("D" & j).Value = WH2.Range("D" & i).Value
      WH7.Range("E" & j).Value = WH2.Range("E" & i).Value
      WH7.Range("F" & j).Value = WH2.Range("F" & i).Value
    Case "I"
      WH7.Range("I" & j).Value = WH2.Range("B" & i).Value
      WH7.Range("J" & j).Value = WH2.Range("C" & i).Value
      WH7.Range("K" & j).Value = WH2.Range("D" & i).Value
      WH7.Range("L" & j).Value = WH2.Range("E" & i).Value
      WH7.Range("M" & j).Value = WH2.Range("F" & i).Value
    Case "P"
      WH7.Range("P" & j).Value = WH2.Range("B" & i).Value
      WH7.Range("Q" & j).Value = WH2.Range("C" & i).Value
      WH7.Range("R" & j).Value = WH2.Range("D" & i).Value
      WH7.Range("S" & j).Value = WH2.Range("E" & i).Value
      WH7.Range("T" & j).Value = WH2.Range("F" & i).Value
  End Select
 
[2]
  WH2.Range(i & ":" & i).Delete
  LG = WH2.Range("A65536").End(xlUp).Row
  Randomize
  i = Int(Rnd() * LG) + 2
  If i = LG + 1 Then
    Do Until i < LG
      Randomize
      i = Int(Rnd() * LG) + 2
    Loop
  End If
End Sub
　 ～～～～～～～ソース５．-ここまで～～～～～～～～

ソース５でやっていること→各所配置
[1]メイン動作でRetuに入れた値によってSelect Caseをする。
　「Ramdam」で出したｉの行から値を抜き出しWH7に格納。

[2]並び替えのシートからi行目を削除し、再度iを求める
　

このコードを実行するとこのように配役が割り振られます。
自分のキャラクターなどで代用して遊ぶのが楽しみ方です（笑）

図1.引き





















図2.アップ















以上で「配役配置」は終了です。

 

～おまけ～
○「Ｅｒａｓｅ」の注意
　前回のおしゃべりの時に配列変数を初期化する「Erase」について
　お話したかと思います。
　本日は書き忘れていたEraseの注意をば。

　1.文字型　　：　Rac(4) As String
　　この配列をEraseにかけると配列の中身は
　　Rac(0)～Rac(4) = ""　→ 長さ0の文字列が入ります
　
　2.数値型　　：　Rac(4) As Integer
　　この配列をEraseにかけると配列の中身は
　　Rac(0)～Rac(4) = 0　→ 数字の０が入ります

　3.動的配列　：　Rac() As Variant
　　※Redim　Rac(4)で再宣言したことを前提
　　この配列をEraseにかけると配列が解除されます。
　　どういうことかというと、Redimで「4」を定義したものを
　　なかったことにしてるって話です。
　　
　　実際やってみると分かりますが、
　　'-------------------------------
　　Dim Rac() As Variant
　　
　　Sub sand()
  　　ReDim Rac(4)
  　　
  　　For i = 0 To 4
    　　Rac(i) = i
    　　Debug.Print Rac(i)
  　　Next
　　End Sub
　　'-------------------------------
　　というプログラムを実行すると、イミディエイトウィンドウには
　　Rac(i)の値ということで0～4の値が記述されます。

　　ではこれをEraseにかけてもう一度。
　　
　　


 

　　
　　はいこうなりました。

　　デバッグで見てみると、Forの始まりでいきなり駄目になってます。
　　























　　ということで、動的配列にEraseを使うとこんな目に遭うので
　　気をつけましょう。
　　中身をクリアしたい場合は、面倒ですがFor文で回して空白なり
　　0なりを入れていくしかないかと（若槻のレベルではそれが限界）

それでは本日はこれにて。

 

こんばんは若槻です。
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に入っていた値を保持したまま宣言しなおす
　
　＝上のやり方だと前の値が消えて、下のやり方だと元の値の
　　後ろあたりにデータが入れられるようになる

 

こんばんは若槻です。
ノリとテンションでモバイルPC買ってきてしましました！　
……あれおかしいな、ちょっと見に行ってきただけなのｎ（ｒｙ
まあ良いんですがね、結構なお値段なのが在庫処分で安くなってた上に
値切ったから元値に比べたら凄く安く買えたので。


さて、本日は久々にVBAのおしゃべりです。
前座なしにさくさくいきまーす！

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


４．学校ごと
○やりたいこと
このマクロでやりたいのは学校ごとに人をまとめて並び替えることです。
ついでに名前の50音順で並び換わるようにもしています。


○ソース

～～～～～～～ソース１．-ここから～～～～～～～～
'====================================================================
'学校別
'====================================================================
Sub GakkouWake()
  SheetSet
  DontLook
 
[1]
  WH5.Cells.Delete

 
[2]
  '=====WH2にWH1のデータをコピーして並び替え－ここから===========
  SyokiCopy
 
  WH2.Select
  LG = WH2.Range("A65536").End(xlUp).Row
  WH2.Range("A2:G" & LG).Sort _
            Key1:=Range("E2"), order1:=xlAscending, _
            key2:=Range("F2"), order2:=xlDescending, _
            key3:=Range("C2"), order3:=xlAscending
           
   WH2.Range("A1").Select
  '=====WH2にWH1のデータをコピーして並び替え－ここまで===========
 
[3]
  i = 2  'WH2(並び替え)用
  LG = WH2.Range("A65536").End(xlUp).Row
  GakkouMei = WH2.Range("E2").Value
  GakkouSuu = 1  '学校数用
 
 
[4]
  '================項目追加=========================
  WH5.Range("A1").Value = GakkouMei
  WH5.Range("A2").Value = "名前"
  WH5.Range("B2").Value = "よみ"
  WH5.Range("C2").Value = "性別"
  WH5.Range("D2").Value = "学年"
 
  WH5.Range("A1:D1").MergeCells = True
  WH5.Range("A1:D2").HorizontalAlignment = xlCenter
  WH5.Range("A1:D1").Borders(xlEdgeBottom).LineStyle = xlContinuous
  WH5.Range("A2:D2").Borders(xlEdgeBottom).LineStyle = xlDouble
  '=================================================

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

ソース１でやっていること→初期動作
[1]シートのクリア
[2]書いてある通りですが、並び替え先のシートに元データをコピーして
　 「学校名」「学年」「よみ」でソートしてます。
　　ちなみに学校名は昇順、学年は降順、よみは昇順です。
[3]使う変数の初期化
　　i ：並び替えのシートを回す用
　　LG：最終行取得用
　　GakkouMei：比較する学校名を格納
　　GakkouSuu：いくつの学校があるか
[4]A1:D2にそれぞれに対応する項目名を入れ、中央寄せやら罫線引き 

 

  ～～～～～～～ソース２．-ここから～～～～～～～～
[1]
  GakkouGyou = 3  '配置する行
  GakkouRetu = 1  '配置する列
  MaxGyo = 0    '最大行
  TaikiGyo = 0  '現在が始まったときのMaxGyoの値
  Turn = 0  '行が変わったかどうか
  CNT = 0   '学生数カウント
 
  '本動作
  Do Until i > LG【α】
[2]
   If WH2.Range("E" & i).Value = GakkouMei Then
      WH5.Cells(GakkouGyou, GakkouRetu).Value = WH2.Range("B" & i).Value
      WH5.Cells(GakkouGyou, GakkouRetu + 1).Value = WH2.Range("C" & i).Value
      WH5.Cells(GakkouGyou, GakkouRetu + 2).Value = WH2.Range("D" & i).Value
      WH5.Cells(GakkouGyou, GakkouRetu + 3).Value = WH2.Range("F" & i).Value
      GakkouGyou = GakkouGyou + 1
      CNT = CNT + 1
      If MaxGyo < GakkouGyou Then
        MaxGyo = GakkouGyou
      End If
    Else
      GakkouMei = WH2.Range("E" & i).Value
     
      '================合計値の格納========================
      WH5.Cells(GakkouGyou, GakkouRetu + 2).Value = "合計"
      WH5.Cells(GakkouGyou, GakkouRetu + 3).Value = CNT
      j = GakkouRetu
      ConvertToLetter (j)
      Retu2 = Retu
      j = GakkouRetu + 3
      ConvertToLetter (j)
      WH5.Range(Retu2 & GakkouGyou & ":" & Retu & GakkouGyou).Borders(xlEdgeTop).Weight = xlMedium
      CNT = 0
      '=====================================================
[3]     
      If GakkouRetu = 11 Then
        TaikiGyo = MaxGyo
      End If
      GakkouSuu = GakkouSuu + 1
      If GakkouRetu = 11 Then
        GakkouGyou = MaxGyo + 5
        GakkouRetu = 1
        Turn = Turn + 1
      Else
        If Turn >= 1 Then
          GakkouGyou = TaikiGyo + 5
          GakkouRetu = GakkouRetu + 5
        Else
          GakkouGyou = 3
          GakkouRetu = GakkouRetu + 5
        End If
      End If
 
[4]    
      '====================================項目名=============
      WH5.Cells(GakkouGyou - 2, GakkouRetu).Value = GakkouMei
      WH5.Cells(GakkouGyou - 1, GakkouRetu).Value = "名前"
      WH5.Cells(GakkouGyou - 1, GakkouRetu + 1).Value = "よみ"
      WH5.Cells(GakkouGyou - 1, GakkouRetu + 2).Value = "性別"
      WH5.Cells(GakkouGyou - 1, GakkouRetu + 3).Value = "学年"
      Select Case GakkouRetu
        Case 1
          WH5.Range("A" & GakkouGyou - 2 & ":D" & GakkouGyou - 2).MergeCells = True
          WH5.Range("A" & GakkouGyou - 2 & ":D" & GakkouGyou - 1).HorizontalAlignment = xlCenter
          WH5.Range("A" & GakkouGyou - 2 & ":D" & GakkouGyou - 2).Borders(xlEdgeBottom).LineStyle = xlContinuous
          WH5.Range("A" & GakkouGyou - 1 & ":D" & GakkouGyou - 1).Borders(xlEdgeBottom).LineStyle = xlDouble
        Case 6
          WH5.Range("F" & GakkouGyou - 2 & ":I" & GakkouGyou - 2).MergeCells = True
          WH5.Range("F" & GakkouGyou - 2 & ":I" & GakkouGyou - 1).HorizontalAlignment = xlCenter
          WH5.Range("F" & GakkouGyou - 2 & ":I" & GakkouGyou - 2).Borders(xlEdgeBottom).LineStyle = xlContinuous
          WH5.Range("F" & GakkouGyou - 1 & ":I" & GakkouGyou - 1).Borders(xlEdgeBottom).LineStyle = xlDouble
        Case 11
          WH5.Range("K" & GakkouGyou - 2 & ":N" & GakkouGyou - 2).MergeCells = True
          WH5.Range("K" & GakkouGyou - 2 & ":N" & GakkouGyou - 1).HorizontalAlignment = xlCenter
          WH5.Range("K" & GakkouGyou - 2 & ":N" & GakkouGyou - 2).Borders(xlEdgeBottom).LineStyle = xlContinuous
          WH5.Range("K" & GakkouGyou - 1 & ":N" & GakkouGyou - 1).Borders(xlEdgeBottom).LineStyle = xlDouble
      End Select
      '=============================================================
     
    End If
    i = i + 1
  Loop【α】
 
 ～～～～～～～ソース２．-ここまで～～～～～～～～
ソース２でやってること→シート「学校別」に各学校ごとに格納
[1]これも値の初期化ですね。今更ですが上でやれって話だｗ
 　 GakkouGyou：配置する行
　  GakkouRetu：配置する列
 　 MaxGyo    ：最大行
  　TaikiGyo  ：現在が始まったときのMaxGyoの値
　  Turn  　　：行が変わったかどうかの判断。
 　 CNT     　：各学生数カウント

※【α】のループ
　→並べ替え用のシートにある全てのデータを読み終わるまで

[2]現在読んでいる行の学校名が変数GakkouMeiと一致するか
　（Then＝正しい場合）
　　　GakkouRetuとGakkouGyouに一致するセルに対応する値を格納
　　　全ての値を入れ終わったら行をひとつプラスする。
　　　同一校なので生徒数であるCNTにも１をプラス
　
　　　～「Cells」の使い方～
　　　シート名.Cells(行番号、列番号)
　　　→列名が分からない、という時は「Range」よりこっちがお勧めです。
　　　
　（Else＝違っている場合）
　　　1.変数GakkouMeiに現在の行の学校名を格納
　　　2.CNTの値をそれまで見ていた学校の合計として
　　　　その学校の最終行に追加。その後CNTを空にする
　　　　※ちなみに「ConvertToLetter (j)」は数字を列数に変えるマクロです。
　　　　　実はここで使う必要はなかった気がしてます←
　　　　　これは後ほどご説明しますね。

[3]行の折り返し
　　・たくさん学校があると、そのまま横に入れていくととんでもなく
　　　横に長くなってしまいますね。
　　　若槻は縦に長いのは平気だけど横に長いのは嫌いなので
　　　３校が横に並んだらそこで折り返し最大行から５行分追加した
　　　位置から次の学校を出すようにしました。

　　・変数MaxGyoはそのための変数ですね。一番数の多い学校に
　　　あわせるために必要です。

　　・変数Turnは１行目に来る場合と折り返して２行目以降に
　　　来るかによって始まる位置が変わるのでそのために使ってます。

[4]項目名の格納　→　そのままです

 
  ～～～～～～～ソース３．-ここから～～～～～～～～
[1]
 '================合計値の格納========================
  WH5.Cells(GakkouGyou, GakkouRetu + 2).Value = "合計"
  WH5.Cells(GakkouGyou, GakkouRetu + 3).Value = CNT
  j = GakkouRetu
  ConvertToLetter (j)
  Retu2 = Retu
  j = GakkouRetu + 3
  ConvertToLetter (j)
  WH5.Range(Retu2 & GakkouGyou & ":" & Retu & GakkouGyou).Borders(xlEdgeTop).Weight = xlMedium
  CNT = 0
  '=====================================================
 
 
  '列幅のオートフィット
  For i = 1 To 15
    WH5.Rows(i).EntireColumn.AutoFit
  Next
 
 
  WH5.Select
  WH5.Range("A1").Select
  OKLook
End Sub
～～～～～～～ソース３-ここまで～～～～～～～～

ソース３でやってること→最終処理
[1]
　　・合計値の格納がまた出てきましたが、これは一番最後に見た学校の分です。
　　　これがないと最後の学校だけ合計値が出てきません。
　　　はぶられてます。それはよくない（何
　　・列幅のオートフォーマット。名前の長い人もいますものね
　　・最後はシートを選択してA1にカーソルを持ってきて終了です。

 
結果はこうなるです↓

 

学校名とキャラクターにつっこんじゃいけないｗｗ


では本日はここまで。
お疲れ様でしたー。

 

～おまけ～
プログラムを作っていると「一文が長くなってしまう」ってこと、ありません？
そんな時はこれ。

「　_　」

ご覧の通り、アンダーバーです。
使い方としてはこうなります。

「　WH5.Range(Retu2 & GakkouGyou & ":" & Retu & GakkouGyou). _
    Borders(xlEdgeTop).Weight = xlMedium　」

前のプログラムの後に半角スペースを挿入→アンダーバー、の順です。
この半角スペースを忘れると怒られますからご注意くださいね。



以下拍手返信です。
また、無名の拍手の方々もありがとうございました。
昨日の記事の内容からして励ましだと受け取らせていただきました！
 

皆さんこんばんは若槻です。件のシステムはちょろちょろと
難題風味になってはあっさり直ったりと意地悪加減がハンパない！
最近帰りが徐々に遅くなってます……（´д｀）

さて本日は先日の続きでVBAのおしゃべりです。
やっぱり隠しません←

====================================================
◎システム名　「演習-学生名簿」
====================================================

～現在ある内容～
・グループ分け
・学年別　　←簡単１
・学校別
・性別ごと　←簡単２　　　　←終了
・配役配置
・試合
・検索
・選抜
・動き
・条件別グループ分け（作成中

それでは今日は学年分けを解説しようと思います。
やってることの大半が「性別ごと」と同じようなものですから
大半は削ります。

※その前にお知らせ
この記事から以降は「プロシージャ」を「マクロ」と表記します。
理由→単純にプロシージャと入れるのが面倒だから（すみませんΣ

３．学年ごと
○やりたいこと
このマクロでやりたいのは学年ごとに人を並び替えることです。
ついでに名前の50音順で並び換わるようにもしています。

○ソース
この間のソースを一気に流して「うーん？」ってなったので
今日は途中途中で切りながらいきます。

 

～～～～～～～ソース１．-ここから～～～～～～～～
'==============================================
'学年分け
'==============================================
Sub GakunenWake()
  SheetSet
  DontLook
 
[1]
  WH4.Cells.Delete

[2]
  'ウィンドウ枠の解除
  ActiveWindow.FreezePanes = False
 
[3]
  i = 2
  LG = WH1.Range("A65536").End(xlUp).Row
  CNT1 = WorksheetFunction.CountIf(WH1.Range("F1:F" & LG), "1")
  ReDim Gakunen1(CNT1)
  CNT2 = WorksheetFunction.CountIf(WH1.Range("F1:F" & LG), "2")
  ReDim Gakunen2(CNT2)
  CNT3 = WorksheetFunction.CountIf(WH1.Range("F1:F" & LG), "3")
  ReDim Gakunen3(CNT3)
 
[4] 
  j = 0  '1年用
  k = 0  '2年目
  l = 0  '3年目
  Do Until i > LG
    If WH1.Range("F" & i).Value = "1" Then
      Gakunen1(j) = WH1.Range("A" & i).Value
      j = j + 1
    End If
    If WH1.Range("F" & i).Value = "2" Then
      Gakunen2(k) = WH1.Range("A" & i).Value
      k = k + 1
    End If
    If WH1.Range("F" & i).Value = "3" Then
      Gakunen3(l) = WH1.Range("A" & i).Value
      l = l + 1
    End If
    i = i + 1
  Loop
 
[5]
  '==========項目名等の編集================
  WH4.Range("A1").Value = "１年生"
  WH4.Range("A1:D1").MergeCells = True
 
  WH4.Range("E1").Value = "２年生"
  WH4.Range("E1:H1").MergeCells = True
 
  WH4.Range("I1").Value = "３年生"
  WH4.Range("I1:L1").MergeCells = True
 
  WH4.Range("A2,E2,I2").Value = "名前"
  WH4.Range("B2,F2,J2").Value = "よみ"
  WH4.Range("C2,G2,K2").Value = "性別"
  WH4.Range("D2,H2,L2").Value = "学校"
 
  WH4.Range("A1:L2").HorizontalAlignment = xlHAlignCenter
  WH4.Range("A2:L2").Borders(xlEdgeBottom).LineStyle = xlDouble
  '=========================================

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

ソース１でやっていること→初期動作
[1]シートのクリア（中身のデリート）
[2]ウィンドウ枠の解除
[3]１年、２年、３年の人数をカウントし変数Gakunen1,2,3を再宣言
[4]学年に合った配列の変数に通し番号を入れていく
[5]項目名の入力

　「　WH4.Range("E1:H1").MergeCells = True　」
　
　見直したら解説してなかったので……「MergeCells」はセルの結合です。
　
　「　Range("結合したいセル").MergeCells = True　」

　ちなみに解除するのはこれを「True」を「False」にするだけです。

 
  ～～～～～～～ソース２．-ここから～～～～～～～～
[1]
 j = 0  'Gakunen1を回す用
  h = 3  'WH4（学年別）に入れる用
  i = 2  'WH1（学生一覧）を回す用
  Do Until j > CNT1
    Do Until i > LG
      If Gakunen1(j) = WH1.Range("A" & i).Value Then
        WH4.Range("A" & h).Value = WH1.Range("B" & i).Value
        WH4.Range("B" & h).Value = WH1.Range("C" & i).Value
        WH4.Range("C" & h).Value = WH1.Range("D" & i).Value
        WH4.Range("D" & h).Value = WH1.Range("E" & i).Value
        h = h + 1
        Exit Do
      End If
      i = i + 1
    Loop
    i = 2
    j = j + 1
  Loop
  WH4.Select
  WH4.Range("A3:D" & CNT1 + 2).Sort Key1:=Range("B3"), order1:=xlAscending
   

 [2]  
  k = 0  'Gakunen2を回す用
  h = 3  'WH4（学年別）に入れる用
  i = 2  'WH1（学生一覧）を回す用
  Do Until k > CNT2
    Do Until i > LG
      If Gakunen2(k) = WH1.Range("A" & i).Value Then
        WH4.Range("E" & h).Value = WH1.Range("B" & i).Value
        WH4.Range("F" & h).Value = WH1.Range("C" & i).Value
        WH4.Range("G" & h).Value = WH1.Range("D" & i).Value
        WH4.Range("H" & h).Value = WH1.Range("E" & i).Value
        h = h + 1
        Exit Do
      End If
      i = i + 1
    Loop
    i = 2
    k = k + 1
  Loop
  WH4.Select
  WH4.Range("E3:H" & CNT2 + 2).Sort Key1:=Range("F3"), order1:=xlAscending
   

[3]   
  l = 0  'Gakunen3を回す用
  h = 3  'WH4（学年別）に入れる用
  i = 2  'WH1（学生一覧）を回す用
  Do Until l > CNT3
    Do Until i > LG
      If Gakunen3(l) = WH1.Range("A" & i).Value Then
        WH4.Range("I" & h).Value = WH1.Range("B" & i).Value
        WH4.Range("J" & h).Value = WH1.Range("C" & i).Value
        WH4.Range("K" & h).Value = WH1.Range("D" & i).Value
        WH4.Range("L" & h).Value = WH1.Range("E" & i).Value
        h = h + 1
        Exit Do
      End If
      i = i + 1
    Loop
    i = 2
    l = l + 1
  Loop
  WH4.Select
  WH4.Range("I3:L" & CNT3 + 2).Sort Key1:=Range("J3"), order1:=xlAscending
 ～～～～～～～ソース２．-ここまで～～～～～～～～

ソース２でやってること→シート「学年別」に各学年ごとに格納
[1][2][3]
実はやってること全部同じ。
変数ｌをCNT1,2,3の数まで回して、変数Gakunen1,2,3に入っている
通し番号と学生一覧を比較します。

そして一致したものを引っ張ってきて学年別の各列に格納してます。
１年→A:D列
２年→E:H列
３年→I:L列

で、最後に各学年を名前ごとにソート。

「　WH4.Range("I3:L" & CNT3 + 2).Sort Key1:=Range("J3"), order1:=xlAscending　」

書き方はこうですね。

「　Range(並べ替えたい範囲).Sort (←半角スペース)
　　Key1:=Range(並び替えのキー),
　　order1:=xlAscending(昇順。降順→xlDescending)　」

ちなみにソートのキーは3つまで使えます。
これ以上やりたい場合は、2回3回に分けましょう。
その時は優先度の低いキーを先にすると望んだ通りに並び変わるはずです。
……間違えてたらごめんなさい←

  
 
 ～～～～～～～ソース３．-ここから～～～～～～～～
[1]
  '列幅のオートフィット
  LR = WH4.UsedRange.Columns.Count
  For i = 1 To LR
    WH4.Rows(i).EntireColumn.AutoFit
  Next
 
[2]
  '罫線
  LG = WH4.UsedRange.Rows.Count
  WH4.Range("D1:D" & LG).Borders(xlEdgeRight).Weight = xlMedium
  WH4.Range("H1:H" & LG).Borders(xlEdgeRight).Weight = xlMedium
  WH4.Range("L1:L" & LG).Borders(xlEdgeRight).Weight = xlMedium

[3] 
  'ウィンドウ枠の固定
  WH4.Range("3:3").Select
  ActiveWindow.FreezePanes = True
 
 
  WH4.Range("A1").Select
  OKLook

～～～～～～～ソース３-ここまで～～～～～～～～

ソース３でやってること→最終処理
[1]列幅のオートフィット
　最初の処理で前回の列幅も消えているので調整します。
　最初から列幅を指定するよりも最後に自動調整しているので、
　まあ、間違いはないかと。

[2]罫線を引く
　変数LGに使っている行数を格納。
　そして、1行目からLG行までの学年の境に中太線を引きます。

[3]ウィンドウ枠の固定
　今回は1行目に学年、2行目に項目名が入ってるので3行目以降が
　動くようにします。
　ちなみに行選択の場合ウィンドウ枠の固定は選ばれた行から上が
　固定されます。
　一回適当にやってみると覚えやすいかもですね！

 

ではでは、本日はここまでです。

※ちょっとした小技※
……ってほどでもないですけど、Excel画面で「Alt+F11」で
簡単にVBAの画面が出てきます。
いちいちボタン押したりするのが面倒な方や興味のある方は
試してみるといいかもしれません

 

皆さんこんばんは若槻です。
金曜日に「もう駄目だーーーっっ」とか騒いでいたＱＲコード問題は
無事に解決されました。

午前中丸々と言えるほどそばで付き合ってくれた課長。
何度も見に来ていろいろ考えたり解決策をネットで探ってくれた先輩。
そして解決の方法を見つけて教えてくれた同期。
みなさん本当にありがとうございましたー!!!!


さて、では昨日の続きで本日もＶＢＡのおしゃべりです。
今日も隠しませんので悪しからずｏ（＿　＿）ｏ


====================================================
◎システム名　「演習-学生名簿」
====================================================

～現在ある内容～
・グループ分け
・学年別　　←簡単１
・学校別
・性別ごと　←簡単２
・配役配置
・試合
・検索（作成中


システムを作成した順としては上から流れる感じなんですが、
今日は簡単なところから行くとして「性別ごと」について語ろうかと
思います。

ツールバーはいつ語ろうか……。
どなたか（いないかな？　いてもきりちゃんでしょうか）、
「早く文字ツールバーのやり方知りたい」って思ったら連絡くださいな。
若槻も語りたいのでいつでも行きますｗ
※文字ツールバー＝こんなの↓





では、はじめましょうか。


１．ワークシート
とりあえず前提と言うことで語っておきます。

○項目
このシステムの大元になるのがシート「学生一覧」に格納されている
学生のデータです。
ちなみに若槻の場合は適当に作った面々とネットから拾ってきた
キャラクターの名前が入っています。

その項目がこちら。





[1]通し番号　　←そのまま。ただし名前が入ったら自動で入るようにしている
[2]名前　　　←そのまま
[3]よみ　　　←これがないと出来ないことも多い
[4]性別　　　←遊び心を出すためのお友達
[5]学校名　　←同上
[6]学年　　　←同上
[7]所属グループ　　←「グループ分け」の時に入る


○ワークシートに変更があった時
「マクロ」やら「プロシージャ」やら言うと標準モジュールに書くのが
まあ一番よくあるパターンでしょうか。
けど、実はワークシート自体にもワークブック自体にもそれらに
関するプロシージャが最初から用意されています。

今回で言うなら「通し番号」の項目がそれですね。
これは「ワークシートに変更があったら」というマクロを組んでいます。

それがこちら。

Private Sub Worksheet_Change(ByVal Target As Range)
  LG = Range("B65536").End(xlUp).Row
  If Range("B" & LG).Value <> "" Then
    Range("A" & LG).Value = Range("A" & LG - 1).Value + 1
  End If
End Sub

上から何をしているのかを言っていくと、

「　LG = Range("B65536").End(xlUp).Row　」

これは変数LG（Long型）に最終行の格納をしています。
最終行や最終列を取る時は上からや左から取る方法も
もちろんありますが、途中で空白行があった時に「んん？」と
なるので下から・右から取ってきた方がいいですね。

シート名．Range（"最終行を取りたい列＋Excelの最終行"）．
　　　　　　End（どの方向に行くか）．Row

でももっと早く取りたい人はこっちの方がいいかもですね。

  LG = WH3.UsedRange.Rows.Count

これは「使ったセル」を見つけてくるっていうもの。
ちなみに若槻は列見つけてくる時にしか使わないです。
え？　何でって？　単なる慣れの問題ですｗ

列のときはこうですね。

  LG = WH3.UsedRange.Columns.Count

さてずれましたが続けましょう。
次はこれですね。

  If Range("B" & LG).Value <> "" Then
    Range("A" & LG).Value = Range("A" & LG - 1).Value + 1
  End If

今回の場合はB列、つまり名前列に何か入力されたらA列に
ひとつ上の番号に１を足した値を入れる、というものなので

「B列の最終行に値が入った場合A列の最終行のセルに
　その上のセルの値に１を足した値を入れる｣

ということをやっています。



１．性別ごと
では本日の本題にいきますか。
星の着いた抜き出し部分の解説は下でやりますから、
これは読み飛ばしても大丈夫です。

～～～～～～～ソース～～～～～～～～
'==============================================
'性別分け
'==============================================
Sub SeibetuWake()
  DontLook
  SheetSet
  
  WH6.Cells.Delete----☆

  'ウィンドウ枠の解除
  WH6.Select
  ActiveWindow.FreezePanes = False-------☆
 
 
  '====================項目設定=====================
  WH6.Range("A1").Value = "男"
  WH6.Range("A1:D1").MergeCells = True
  WH6.Range("E1").Value = "女"
  WH6.Range("E1:H1").MergeCells = True
 
  WH6.Range("A2,E2").Value = "名前"
  WH6.Range("B2,F2").Value = "よみ"
  WH6.Range("C2,G2").Value = "学校"
  WH6.Range("D2,H2").Value = "学年"
  
  WH6.Range("A1:H2").Font.Bold = True-------☆
  WH6.Range("A1:H2").HorizontalAlignment = xlCenter-------☆
  WH6.Range("A1:H1").Borders(xlEdgeBottom).LineStyle = xlContinuous
　-------☆　
  WH6.Range("A2:H2").Borders(xlEdgeBottom).LineStyle = xlDouble
　-------☆
  '=================================================
 
  '男女の数を数える
  LG = WH1.Range("A65536").End(xlUp).Row
  CNT1 = WorksheetFunction.CountIf(WH1.Range("D1:D" & LG), "男")
　-------☆
  ReDim Boys(CNT1)-------☆
  CNT2 = WorksheetFunction.CountIf(WH1.Range("D1:D" & LG), "女")
  ReDim Girls(CNT2)
 
  '男女ごとに変数に格納していく
  j = 0  '男子用
  k = 0  '女子用
  i = 2  'WH1用
  Do Until i > LG
    If WH1.Range("D" & i).Value = "男" Then
      Boys(j) = WH1.Range("A" & i).Value
      j = j + 1
    End If
    If WH1.Range("D" & i).Value = "女" Then
      Girls(k) = WH1.Range("A" & i).Value
      k = k + 1
    End If
    i = i + 1
  Loop
 
  '実動作
  j = 0  'Boysを回す用
  h = 3  'WH6（性別）に入れる用
  i = 2  'WH1（学生一覧）を回す用
  Do Until j > CNT1
    Do Until i > LG
      If Boys(j) = WH1.Range("A" & i).Value Then
        WH6.Range("A" & h).Value = WH1.Range("B" & i).Value
        WH6.Range("B" & h).Value = WH1.Range("C" & i).Value
        WH6.Range("C" & h).Value = WH1.Range("E" & i).Value
        WH6.Range("D" & h).Value = WH1.Range("F" & i).Value
        h = h + 1
        Exit Do
      End If
      i = i + 1
    Loop
    i = 2
    j = j + 1
  Loop
  WH6.Range("A3:D" & CNT1 + 2).Sort _
            Key1:=Range("D3"), order1:=xlDescending, _
            Key2:=Range("B3"), order2:=xlAscending, _
            Key3:=Range("C3"), order3:=xlAscending
 
 
  k = 0  'Girlsを回す用
  h = 3  'WH6（性別）に入れる用
  i = 2  'WH1（学生一覧）を回す用
  Do Until k > CNT2
    Do Until i > LG
      If Girls(k) = WH1.Range("A" & i).Value Then
        WH6.Range("E" & h).Value = WH1.Range("B" & i).Value
        WH6.Range("F" & h).Value = WH1.Range("C" & i).Value
        WH6.Range("G" & h).Value = WH1.Range("E" & i).Value
        WH6.Range("H" & h).Value = WH1.Range("F" & i).Value
        h = h + 1
        Exit Do
      End If
      i = i + 1
    Loop
    i = 2
    k = k + 1
  Loop
  WH6.Range("E3:H" & CNT2 + 2).Sort _
            Key1:=Range("H3"), order1:=xlDescending, _
            Key2:=Range("F3"), order2:=xlAscending, _
            Key3:=Range("G3"), order3:=xlAscending
 
 
 
  '列幅のオートフィット
  LR = WH6.UsedRange.Columns.Count
  For i = 1 To LR
    WH6.Rows(i).EntireColumn.AutoFit-------☆
  Next
 
  '罫線
  LG = WH6.UsedRange.Rows.Count
  WH6.Range("D1:D" & LG).Borders(xlEdgeRight).LineStyle = xlDouble
  WH6.Range("H1:H" & LG).Borders(xlEdgeRight).Weight = xlMedium
 
  'ウィンドウ枠の固定
  WH6.Range("3:3").Select-------☆
  ActiveWindow.FreezePanes = True-------☆
 
 
  WH6.Range("A1").Select
  OKLook
End Sub

～～～～～～～～～～ソース－ここまで～～～～～～～～～～～～～

○セルのデリート
これはそのままですね。

「  WH6.Cells.Delete　」

で、WH6のセルを全てデリートしています。
列幅や業の高さなどにこだわらない時などには使うといいかと。

○ウィンドウの固定と解除
ウィンドウを固定したい、ということはExcelを使う人なら
大なり小なり思うことではないでしょうか。
たとえばデータ数が多いときなどに、項目名がいつでも出るように
したい、とか。

そんなときに便利なのがこれですね。

  'ウィンドウ枠の固定
  WH6.Range("3:3").Select　　←固定したい行や列を選択
  ActiveWindow.FreezePanes = True

で、逆に解放するのがこれです。

　'ウィンドウ枠の解除
  WH6.Select　　←シートを選択
  ActiveWindow.FreezePanes = False

○太字
「項目名とかに太字を使いたい」って言う時にでも。

「 WH6.Range("A1:H2").Font.Bold = True　」

これを「False」にすると太字は解除されます。
斜体文字も同じ感じですね。

○中央寄せ
文字の中央寄せです。

「　WH6.Range("A1:H2").HorizontalAlignment = xlCenter　」

この「xlCenter」の所は実はもうちょっと長い書き方の
はずなんですが、バグなのかなんなのかこれでもいけたので
これで行ってます。

ちゃんとやりたい方は調べることをお勧めします（コラ

○罫線
罫線は色々ありますけど、とりあえず基本的なものだけ。

「　シート.セル.Borders(引く場所).LineStyle = 線の種類　」
「　シート.セル.Borders(引く場所).Weight = 線の太さ」
　
（Ex）
「 WH6.Range("D1:D" & LG).Borders(xlEdgeRight).LineStyle = xlDouble 」
「 WH6.Range("H1:H" & LG).Borders(xlEdgeRight).Weight = xlMedium 」
「 WH6.Range("A1:H1").Borders(xlEdgeBottom).LineStyle = xlContinuous 」

ちなみにBordersの後ろに何も書かなければ格子状に
罫線が引かれます。
その時にTrueとFalseで使い分けられるのですが、
これはググればすぐに出てくるのでスルーしちゃいます←
あ、線の種類や太さも同様ですのでスルーします＾＾；

○Excelで使える関数を使うために
実はVBAではExcelで使える関数が使えないことがあります。
RoundとかCountとか。

それでも使いたい！　って時がたまにあると思います。

そんな時にはこういう使い方。

「  CNT1 = WorksheetFunction.CountIf(WH1.Range("D1:D" & LG), "男")　」

「WorksheetFunction」をつけることでExcel上の関数が使えるように
なります。
色々あるので、これは実際やってみた方が面白いですよ！

○再宣言
……に、使うのがこれ

「　ReDim Boys(CNT1)　」

配列を使うときなどで、最大数が最初は分からないときなどに有効です。
最初に

Dim　変数()　as　△△

と決めておき、いくつ入れるか分かった場合に上記の通りに
書きます。上で言う「CNT1」にはそれぞれが数を出すために
使った変数が入るのが大体かなーと思います。

あ、この時に使った変数の値を取っておくと、たとえば後で
その配列を回したいときに

Do Until I > CNT1　
（作業）
Loop

とかに使えますよ。Forでもいいし。

○列幅のオートフィット
意外に使うことがあるのがこれ。
いったん全てのセルなどを削除してからデータを入れた後などに
データの中身ごとに列幅を変える、など。

書き方はこうです。

  LR = WH6.UsedRange.Columns.Count
  For i = 1 To LR
    WH6.Rows(i).EntireColumn.AutoFit
  Next

変数LRに使った列のカウントを入れて、Forで終わるまで回し、
その間にシートの１からLR列目の幅を一列ずつ変えていきます。

※注意※
列幅や行の高さ、罫線などは1列ごと・1行ごとに命令を実行しないと
面白いことになりかねません。
気になる方は一度やってみましょう（笑）

 

さて、これで性別ごとは終わりです。
ぶっちゃけ今更このプログラム見るとちょっと手間がかかってるので
別のプログラムのやり方取り入れればもっと早いんですが、
いまさら書き直す気力も無いのでこのまま晒しますｗ

では本日はこの辺りで。
残りはまた後日にでもノ