[[20101101171055]]　『クラブ希望調査表（上位から決定）』（しーたけ）　ページの最後に飛ぶ

『クラブ希望調査表（上位から決定）』（しーたけ）

 過去ログ「20070730142309」の（弥太郎）さんのマクロを試してみました。

[[20070730142309]]　『クラブの希望調査表』（fuki）

 このマクロで学年を同じにした場合、各クラブの定員まで、まず第１希望で埋めて、
 まだ定員未満の場合第2希望、第3希望で埋めていく結果になりました。
 　　希望順（列優先）＞並び順（行優先）

 私の希望は、上位（行番号の低い順）から、決定していく方法です。
 第１希望が定員超過なら第2希望で検討、第2希望も超過なら第3希望、
 第3希望まですべて超過なら未決定として、次の順位（次の行）に移るというものです。
 　　希望順（列優先）＜並び順（行優先）

 過去ログのように、学年で優先する必要はありません（単純に、優先順位で並べます）

 過去ログのマクロを改良すればいいのでしょうが、力不足で先に進みません。

 追加機能として、第１から第３希望のどれで決定したか、一目でわかるように、
 決定したクラブ（過去ログの回答では、C～E列）にもセルに色を付けたいです。

 以上、2点について、教えていただけますでしょうか？
 よろしくお願いします。

 Excel2007/Windows Vista

 弥太郎さんのデータ形式をそのまま借用しました。
　　A列に名前、B列に学年、C、D、E列に希望 2行目以降にデータ
　　H1以降にクラブ名、H2以降に定員

 クラブ名は完全に一致しないと対象となりません（前後に余計なスペースがあったり
 「ー」が「―」だったりはNG）。
 希望のクラブがなかった場合はクラブ名が、
 クラブの定員に漏れてしまった氏名が赤になります。

 Sub 希望通り()
    Dim clubNum As Object
    Set clubNum = CreateObject("Scripting.Dictionary")

    Dim c As Long
    Dim mxCol As Long
    mxCol = Cells(1, Columns.Count).End(xlToLeft).Column
    For c = 8 To mxCol
        clubNum.Add Cells(1, c).Value, CInt(Cells(2, c).Value)
    Next

    Dim r As Long
    Dim mxRow As Long

    mxRow = Cells(Rows.Count, 1).End(xlUp).Row
    Range("H3").Resize(Rows.Count - 2, mxCol).Clear
    Range("A2").Resize(mxRow - 1, 1).Interior.ColorIndex = 3
    Range("B2").Resize(mxRow - 1, 5).Interior.ColorIndex = 2
    Range("A1").Resize(mxRow, 5).Borders.LineStyle = xlContinuous

    For c = 3 To 5
        For r = 2 To mxRow
            If clubNum.exists(Cells(r, c).Value) Then
                If Cells(r, 1).Interior.ColorIndex = 3 Then
                    If clubNum.Item(Cells(r, c).Value) > 0 Then
                        Cells(r, 1).Interior.ColorIndex = 2
                        Cells(r, c).Interior.ColorIndex = 35
                        With Range("H1").Resize(1, mxCol - 7).Find(Cells(r, c).Value, lookat:=xlWhole)
                            Cells(Cells(Rows.Count, .Column).End(xlUp).Row + 1, .Column) = Cells(r, 1).Value
                        End With
                        clubNum.Item(Cells(r, c).Value) = clubNum.Item(Cells(r, c).Value) - 1
                    End If
                End If
            Else
                Cells(r, c).Interior.ColorIndex = 3
            End If
        Next
    Next
 End Sub

 後から思いましたが、学年の列を同じ数値にしてしまえば元のコードでも
 できたのではないでしょうか。
 (Mook)

 Mookさん、ありがとうございます。

 決定したクラブに、色が付き、結果が分かりやすくなりました。
 最後のコメントの通り、学年は同値にすることで無視できる点は分かっております。

 残念ながら、私のメインの希望が、このマクロでは叶えれれませんでした。

 私の希望は、選考順上位の生徒の希望が優先
 希望順（列優先）＜並び順（行優先）

 提示いただいたマクロでは、弥太郎さんのマクロと同様に、
 希望順（列優先）＞並び順（行優先）となりました。

 下記がマクロを実行した結果の一部です。

 氏名「あ～え」は、第一希望が通り、囲碁・将棋は定員になります。
 氏名「お」の場合、第1、2希望が定員なので、第3希望の「バドミントン」に決まるようにしたい。

 弥太郎さん、Mookさんのマクロはともに、氏名「お」が選考漏れとなってしまいます。

 この点を解決するには、どうすればいいのでしょうか？
 　　
 A	B	C	D	E
 氏名	学年	第１	第２	第３希望
 あ	4	囲碁	将棋	卓球
 い	4	将棋	囲碁	バドミントン
 う	4	囲碁	将棋	バドミントン
 え	4	将棋	囲碁	卓球
 お	4	囲碁	将棋	バドミントン
 か	4	将棋	囲碁	卓球
 き	4	囲碁	将棋	卓球

 G	H	I	J	K	L	M	N
 種目	野球	ソフト	バレー	卓球	バドミントン	将棋	囲碁
 定員	9	9	6	2	2	2	2

 （しーたけ）

 行優先というのは、
    For c = 3 To 5
        For r = 2 To mxRow
 を
    For r = 2 To mxRow
        For c = 3 To 5
 ということでしょうか。
 (Mook)

 Mookさん
 ありがとうございます。
 無事うまくいきました。
 先ほどコメントした後に、マクロを読み解きながら、
 ご指摘のところ換えればいける？と思い、これから試したところでした。

 大変勉強になりました。
 ありがとうございました。
 （しーたけ）

コメント返信：

[ 一覧(最新更新順) ]

[[20101101171055]] 『クラブ希望調査表（上位から決定）』（しーたけ） ページの最後に飛ぶ

[[20101101171055]]　『クラブ希望調査表（上位から決定）』（しーたけ）　ページの最後に飛ぶ