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

さて本日は先日の続きで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の画面が出てきます。
いちいちボタン押したりするのが面倒な方や興味のある方は
試してみるといいかもしれません