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

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


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


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

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


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

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





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


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

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

その項目がこちら。





[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行ごとに命令を実行しないと
面白いことになりかねません。
気になる方は一度やってみましょう（笑）

 

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

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