エクセルで成績順・均等の併存するグループ分け

質問

エクセルを利用して、以下のようなグループ分けをしているのですが、これを自動化させたいと考えています。
サンプルデータを元にご説明します。（サンプルは疑似データです）

１．連番、氏名、性別、点数の表から、E22セルのカッティングポイントを元に、IF関数でA,Bの仮グループを作る。１０点以上ならA、未満ならB（「作業前」参照）
２．Bグループはそのまま決定。
３．「仮グループA」「男」でフィルターをかけ、「決定グループ」列に名簿上から順にA1,A2,A1,A2,...と入力
４．「仮グループA」「女」でフィルターをかけ、「決定グループ」列に名簿上から順にA1,A2,A1,A2,...と入力（「作業中」参照）
５．グループ分け完成（「作業完了」参照）

以上ですが、伝わりますでしょうか？
これらの作業を、できればＶＢＡでボタンを押すと自動で実行できるような方法を探しています。
アドバイス頂ければ幸いです。

回答No.1

HohoPapa · ベストアンサー

後記コードでいかがでしょうか。

実行後にフィルターは設定していません。
マクロで設定する必要があれば指摘してください。

Option Explicit

Sub sample()

　Dim r As Long
　Dim LastRow As Long
　Dim CPoint As Long
　Dim SW As Boolean

　'最終行を取得
　LastRow = Cells(Rows.Count, 4).End(xlUp).Row - 1
　CPoint = Cells(LastRow + 1, 4).Value

　'A,Bをセット
　For r = 2 To LastRow
　　If Cells(r, 4).Value < CPoint Then
　　　Cells(r, 5).Value = "B"
　　　Cells(r, 6).Value = "B"
　　Else
　　　Cells(r, 5).Value = "A"
　　End If
　Next r

　'男性のAをA1,A2と交互に分類
　SW = True
　For r = 2 To LastRow
　　If Cells(r, 5).Value = "A" And Cells(r, 3).Value = "男" Then
　　　If SW = True Then
　　　　Cells(r, 6).Value = "A1"
　　　Else
　　　　Cells(r, 6).Value = "A2"
　　　End If
　　　SW = Not SW
　　End If
　Next r

　'女性のAをA1,A2と交互に分類
　SW = True
　For r = 2 To LastRow
　　If Cells(r, 5).Value = "A" And Cells(r, 3).Value = "女" Then
　　　If SW = True Then
　　　　Cells(r, 6).Value = "A1"
　　　Else
　　　　Cells(r, 6).Value = "A2"
　　　End If
　　　SW = Not SW
　　End If
　Next r

End Sub

お礼

Hohopapaさん、質問の仕方のご指摘から、今回のコードのご教授まで、重ね重ねありがとうございました！

A1とA2の変化にBooleanを利用するのですね。ここを一番悩んでいたのですが、
Not SWで反転できるということを今回初めて知りました。

実は最初「型が一致しない…」とのエラーが出たのですが、
CPoint = Cells(LastRow + 1, 4).Value
を
CPoint = Cells(LastRow + 1, 5).Value
と訂正することで正常に動作しました。

これを元に、実務に適用したいと思います。