さっきの続きです。
コードが長くなりすぎたので、いったん今までのコード、全部消します。
Continue reading »
http://q.hatena.ne.jp/1206296468
質問者さんのＣＳＶファイルの中身が、いまいちよくわからないのですが、
こんな感じのＣＳＶファイルが、
こんな感じであったとします。
Continue reading »
3月 292008
http://q.hatena.ne.jp/1206705553
面白そう（＾＾）
Wordのマクロじゃなくて、コメント欄の方と同じくExcelのマクロでやってみたいと思います。
Continue reading »
3月 282008
今まで作ってきたプログラムで、Excelの複数のシートをまたがって処理をしなければならない場合、
例えば、
Sheet1のA列の値をSheet2にコピーする、みたいな処理を作る。。。しょっちゅうやってますが（＾＾；）
Continue reading »
以下の記事は、「重複している行を探して表示する」というものです。
重複している行を１行だけ残して、削除する、というサンプルは、
VBAのお勉強 Excelで１行残して重複行を削除
こちらをご覧下さい。
このブログのリファラーを見ていたら、「Excel VBA 重複行」で検索されている方がいました。
その方はたぶん
http://www.simple-sys.com/blog/2008/03/13/43/
のページを見られたようですが、 これは２列で重複している行を探す、という形の重複行を探すものです。
ただ、一般的に「重複行を探す」といったら、
みたいなデータがあったときに、
「あ」、「う」、「お」、「く」が重複している、
っていうような探し方、のほうが多いような気がします。
なので、今回はVBAを使って、重複した行を探してみたいと思います。
こんな感じで、A列で重複しているデータにはそのB列に「重複」って文字が 入るようにしてみたいと思います。
考え方は、こんな感じ。
- 1行目から見ていって、
- その行の値を次の行から探していき、
- 同じ値があったら、その行と、今見てる行のB列に「重複」の文字を入れる
- これを最後の行まで繰り返す
- その行の値を次の行から探していき、
- っていう作業を最後の１つ前の行まで繰り返す
こんな感じです。
一番最後が、「最後の１つ前の行まで」ってなってます。
なんで最後の行まで繰り返さないか？ その理由は簡単です。
最後の行にはもう、「次の行」がありません。
最後の行はそれ以降にチェックする対象がないので、最後の１つ前の行まで、ということになります。
ということで、コードを作っていきます。
まずは、A列を最初から最後の１つ前までイミディエイトウィンドウに表示させてみます。
Sub test()
Dim lastgyou As Integer
Dim i As Integer
'Sheet1を選択します
Sheets("Sheet1").Select
'最後の行を求めます
ActiveSheet.Range("A1").End(xlDown).Select
lastgyou = ActiveCell.Row
'最後の行まで、B列を空にします。
For i = 1 To lastgyou
ActiveSheet.Cells(i, 2).Value = ""
Next
'1行目から最後の行の１行前まで、とりあえずイミディエイトウィンドウに表示
For i = 1 To lastgyou - 1
Debug.Print (ActiveSheet.Cells(i, 1).Value)
Next
End Sub
まず、最終行の行番号を求めるのはいつもどおりです。
B列の値を全部消して、その後で、１行ずつ表示しています。
実行すると、
（＾＾）いつもとほぼ同じですね。
それでは、今の行より下の行をチェックしていくプログラムを追加してみます。
Sub test()
Dim lastgyou As Integer
Dim i As Integer
Dim j As Integer
Dim atai As String
'Sheet1を選択します
Sheets("Sheet1").Select
'最後の行を求めます
ActiveSheet.Range("A1").End(xlDown).Select
lastgyou = ActiveCell.Row
'最後の行まで、B列を空にします。
For i = 1 To lastgyou
ActiveSheet.Cells(i, 2).Value = ""
Next
'1行目から最後の１つ前の行までチェックします
For i = 1 To lastgyou - 1
'今見ている i 行目の値を atai という変数に入れておきます。
atai = ActiveSheet.Cells(i, 1).Value
'今見ている行（ i ）の１つ下から、最後の行まで、チェックします
For j = i + 1 To lastgyou
'もし、ataiと j 行目が、同じ値だった場合
If atai = ActiveSheet.Cells(j, 1).Value Then
'i行目と、j行目が重複していることになるので、
'両方の行のB列に、「重複」という文字を代入します。
ActiveSheet.Cells(i, 2).Value = "重複"
ActiveSheet.Cells(j, 2).Value = "重複"
End If
Next
Next
End Sub
ataiという変数と j という変数を追加しました。
atai に今見ている i 行目のA列の値を入れておきます。
ｊ で今見ている行の次の行から最後の行まで繰り返し見ていき、 j 行目の値と atai の値が一致した場合、「重複」という値をB列に代入する、となっています。 実行してみると、
ん、できました（＾＾）
これで完成。。。なんですが。
例えば、「あ」について見てみると、
「あ」は１行目と、8行目にあります。
1行目のチェックが終わった段階で、
こんな状態になってます。
プログラムはこの後、２行目、３行目と同じように進んでいきますが、 8行目まで来たときについて考えてみます。
8行目は「あ」です。
「あ」はすでに1行目でチェックしたときに重複していることが分かっていますので、 B列には、「重複」という文字が入っています。
ということは。。。。
８行目まで来たときですが、この「あ」については探す必要がないですよね？（＾＾；）
なぜなら、すでに1行目で重複していることはわかっていますし、仮に9行目以降に「あ」があったとしても、 それはすでに１行目でチェックした際に重複と判断されてB列に「重複」が入ってるはずです。
ということで、
もしB列に「重複」という文字列が入っている場合、その行の値については探す必要がない、
ということをプログラムに組み込んでみます。
Sub test()
Dim lastgyou As Integer
Dim i As Integer
Dim j As Integer
Dim atai As String
'Sheet1を選択します
Sheets("Sheet1").Select
'最後の行を求めます
ActiveSheet.Range("A1").End(xlDown).Select
lastgyou = ActiveCell.Row
'最後の行まで、B列を空にします。
For i = 1 To lastgyou
ActiveSheet.Cells(i, 2).Value = ""
Next
'1行目から最後の１つ前の行までチェックします
For i = 1 To lastgyou - 1
'もし、今見ている行がまだ「重複」じゃない場合
If ActiveSheet.Cells(i, 2).Value = "" Then
'今見ている i 行目の値を atai という変数に入れておきます。
atai = ActiveSheet.Cells(i, 1).Value
'今見ている行（ i ）の１つ下から、最後の行まで、チェックします
For j = i + 1 To lastgyou
'もし、ataiと j 行目が、同じ値だった場合
If atai = ActiveSheet.Cells(j, 1).Value Then
'i行目と、j行目が重複していることになるので、
'両方の行のB列に、「重複」という文字を代入します。
ActiveSheet.Cells(i, 2).Value = "重複"
ActiveSheet.Cells(j, 2).Value = "重複"
End If
Next
End If
Next
End Sub
IF文を使って、i 行目のB列に「重複」が入っていない場合だけ、内側の For Nextを実行するようにしています。
実行してみると、
ん、おっけいですね（＾＾）
こちらにアップしておきます→vbastudy_16.xls
3月 272008
http://q.hatena.ne.jp/1206528619
「関数を利用した方法」ということで、やはりVBAではないですが（＾＾；）
まず、A列の値の中に「A」が入っている位置を調べてみます。
これは、こないだこちらで使いました、「FIND」を使えばよさそうです。
FINDワークシート関数の書式は、
=FIND(検索文字列, 対象, 開始位置)
(開始位置は省略可能、省略した場合は1となり、先頭から探す) で、
見つかった場合、その文字位置（左から何文字目か）、
見つからなかった場合、#VALUE!というエラー を返します。
B,C,D列は最終的に値を入れるので、とりあえず、E列でいろいろやってみます。
E1の計算式に、
=FIND("A",A1)
と入れて、E4までオートフィルしてみます。
ん、おっけい（＾＾）。
というか、全部一文字目に入っているから、「1」になりますね（＾＾；）
もし、A列に「A」が入っていなかった場合、
例えば、A5に「BC」という値を入れて、E5にも先ほどの計算式をオートフィルしてみます。
ん、入ってなければ「#VALUE!」でエラーです（＾＾）
んでは、こんどは「B」を探してみます。F列を使います。
Bが入っていない場合の値も入れておきます。A6に「AC」と入れときます。
F列の式はさっきとほとんど同じですね。F1に
=FIND("B",A1)
と入れ、F6までオートフィルします。すると、こんな感じ。
ん。後はこの値を使ってA列から文字列を抜き出せばよさそうです。
文字列を抜き出すには、MIDワークシート関数を使います。書式は、
=MID(対象文字列,抜き出す開始文字位置,抜き出す文字数)
となります。 抜き出す開始文字位置はAが見つかった位置の次、でよいですから、(E列の値+1)、でよいですね。
抜き出す文字数は、、、これはちょっとめんどくさいですね（＾＾；）
「Bが見つかった位置の前まで」、つまり、（F列の値-1）文字目、まで抜き出せばよいですが、
MID関数で必要になるのは、「抜き出す文字数」です。
これは具体的なデータで考えたほうがわかりやすいですね。 2行目で考えるのがよさそうです。
A2の値、「A10B5C」で、E列の値が「1」、F列の値は「4」です。 この文字列でAとBの間を抜き出すには、
=MID(A2,2,2)
となります。A2の値を2文字目から、2文字分抜き出す。ということです。
2つ目のパラメータの「2」は、これは「A」という文字が見つかった1文字目の次で、1+1=2、これは分かりやすいですね。
3つ目のパラメータの「2」、これはどうやって求めればよいでしょうか？
上の図で黄色と水色の間に何文字あるか？ということですね。
これは、（水色の文字位置）-（黄色の文字位置）-1 という式で間の文字数が求められます。
上の例ですと、4-1-1=2、です。
これは黄色と水色がどこの位置にあってもこの計算式で大丈夫です。
ということで。MIDの関数をB1に入れてみます。
=MID(A1,E1+1,F1-E1-1)
E列が「A」が見つかった位置、F列が「B」が見つかった位置、ですので、 上記のような式になります。
この式をB6までオートフィルすると、
ん、エラーが出ている行は、AまたはBが入っていないのでエラーですが、 それ以外の行は問題なさげです（＾＾）。
AとBがくっついている場合、（1行目、3行目、4行目）、3つめのパラメータは0になります。
0の場合、MID関数は空の文字列になるようですね。
あとはエラーを表示しないようにします。
E列とF列いずれかがエラーだったら何も表示しない、でなければ表示するという感じにしてみます。
B1に、
=IF(OR(ISERROR(E1),ISERROR(F1)),"",MID(A1,E1+1,F1-E1-1))
と入れ、B6までオートフィルします。
ん、いいんでないかい？（＾＾） OR関数は初めて使ったかな？
=OR（式1,式2)
が書式で、式1もしくは式2のいずれかがTRUEならば、この式自体がTRUEになり、 そうでなければ（式1も式2もFALSEの場合）FALSEになる、という関数です。
E列、F列どっちかがエラーならば何も表示せず、そうでなければ表示する、って感じですね。
ん、B列はこれでいいかな？
んでは、次、C列。 これは考え方はB列と全く同じですね。
A列の値の文字列の中で「C」がある位置を探します。G列に入れときます。 G1に、
=FIND("C",A1)
と入れ、G6までオートフィル。 C1に、
=IF(OR(ISERROR(F1),ISERROR(G1)),"",MID(A1,F1+1,G1-F1-1))
と入れ、C6までオートフィル。
ん、よいですね（＾＾） 最後、D列。これは今までの２つとはちょっと違いますね。
「C」以降の文字列を抜き出す、って事ですが、、、
=MID(A1,G1+1,
ここまではすぐわかりますが、、、3つ目のパラメータをどうしましょうかね？
例えば、上の例だと6文字目から1文字抜き出す、 下の例では、4文字目から3文字抜き出す、 っていうのはわかりますけど、この何文字抜き出すのかをどうやって求めるか？
これは、A1の全体の文字数が必要になります。
（全体の文字数）-（Cが見つかった位置） の式で、抜き出す文字数が求められます。
上の例ですと、6-5=1 下の例ですと、6-3=3 となりますね。
全体の文字数が変わったとしても、
上の例では、９-5=4 下の例では4-3=1 という感じで抜き出す文字数が導き出せます。
ということでA列の文字数を求める必要があります。 文字数を求める関数は、LENです。書式は、
=LEN(文字列)
で、これで文字列の長さを求めることが出来ます。
では、D列の計算式を作ってみます。 まず、エラーとか気にしないで作ってみます。D1に
=MID(A1,G1+1,LEN(A1)-G1)
といれ、D6までオートフィルします。
ん、いい感じ（＾＾）
ただ、これはA列に「C」が入っていない場合のことを考えていません。
例えば、A7に「AB」という値を入れて、D1の計算式をD7までオートフィルすると、
当然こうなります。ので、これもエラーが出ないようにします。 D1に、
=IF(ISERROR(G1),"",MID(A1,G1+1,LEN(A1)-G1))
と入れます。 もしG列がエラーだったら何も表示せず、そうでなければ表示する。という感じですね。
D7までオートフィルします。
ん、エラーが消えました（＾＾）
一応これで、質問者さんが必要としている値を求めることは出来ました。
ただ、、、E列以降、邪魔ですよね？（＾＾；）
分かりやすくするために「A」の文字位置などを代入してきましたが、 ワークエリアを使うと見苦しいので、使わないようにしたいです。
B1の計算式は、今、
=IF(OR(ISERROR(E1),ISERROR(F1)),"",MID(A1,E1+1,F1-E1-1))
ですが、このうち、E1とF1の部分、ここを、E1とF1の計算式に置き換えてしまえば、 E1とF1は必要なくなります。
E1となっているところに、FIND(“A”,A1) F1となっているところに、FIND(“B”,A1)を入れればよいですね。
入れ替えた式が、こちら。
=IF(OR(ISERROR(FIND("A",A1)),ISERROR(FIND("B",A1))),"",MID(A1,FIND("A",A1)+1,FIND("B",A1)－FIND("A",A1)－1))
・・・（＾＾；）こうなってしまうと、もうこの式が何を表しているのか、パッと見ではわからないですね。
ただ、この式にはもうE1、F1は入っていませんので、E1、F1の計算式を消しても、B1の値は求まります。
同じようにC1の計算式は、
=IF(OR(ISERROR(FIND("B",A1)),ISERROR(FIND("C",A1))),"",MID(A1,FIND("B",A1)+1,FIND("C",A1)-FIND("B",A1)-1))
D1の計算式は、
=IF(ISERROR(FIND("C",A1)),"",MID(A1,FIND("C",A1)+1,LEN(A1)-FIND("C",A1)))
となります。 これでE列以降はもういらないので、消してみます。
ん、E列以降がなくても、抜き出せてますね（＾＾）
一応完成かな？ここに置いておきます→vbastudy_15.xls
ただし・・・（＾＾；） この状態でも、まだ問題があります。
A列にAやB、Cが複数入っていた場合は想定していません。
この場合は、 最初に出てきたA、最初に出てきたB、最初に出てきたCで判断しますので、２文字目以降は無視する形になります。
また、例えばA列に「COBRA」というように、A、B、Cが想定している順番で入っていない場合などにも、 エラーになってしまいます。
もし、この場合でも、「A」と「B」の間は「R」という形で抜き出すのであれば、Aの位置とBの位置を調べて、 どちらが先に現れるかによって、計算式を分ける必要があります。。。。
今回はめんどくさいのでそこまではやりません（＾＾；）
3月 232008
「いろんなサイトからネタを探してきて、勉強する」のがこのサイトの基本的な編集方針(^^;)なんですが
身内から、「Excelでこんなこと出来ないか？」という相談がありましたので、今回はそのネタで行きます。
いわく、 「名簿をExcelで作ってるんだけど、印刷したときに紙がもったいないので何とかならないか？」との事。
- 名簿はExcelで管理している
- 追加されたり削除されたりする
- 印刷するときには一定の決まりで並べ替えなければならない
どうもこんな感じのデータらしいです。
もちろんデータはダミーです。
良くある苗字と良くある名前でランダムに作りました。
こんな感じのデータが200件くらいあり、追加されたり削除されたりするらしいです。
んで、印刷するときには、
- まず、コードの5～6桁目の値で並べて、
- つぎに、コード全体の値で並べて
で、印刷する必要があるそうです。ん、じゃとりあえず並べ替えを。まず5～6桁目の値で並べるために、そこの桁を抜き出します。 C2のセルの計算式に
=MID(A2,5,2)
と入れて、最後の行までオートフィルで入れます。
ん、いい感じ(^^)
この値とA列の値を使って、データをソートします。
並べ替えるデータを選択して、 データ→並べ替え→ 
で、並べ替えの設定で、 1番目に優先されるキーに「列C」、2番目に優先されるキーに「コード」、それぞれ昇順で設定します。
ん、並び変わりました(^^) んでこれを印刷、と。プレビューで確認すると、
(^^;)まぁ、当然こうなります。全部で200件あるので、今回の場合4ページにもなります。
文字を小さくしたり、行の高さを低くすればもう少し１ページに入る量は増えますが、あんまり小さかったり、詰め詰めだと見難いし。。。
かといってこのまま印刷しても、紙がもったいないし、、、どうにかならないか？ってことらしいです。
Wordとかならページ設定で「段数」という指定が出来て、段組印刷が出来るんですけど、 Excelには今のところそういう機能はないらしいです。
んじゃ、今はどうやってるのか？と聞くと、
「並べ替えたデータを印刷用のシートに手動でコピーして、自分で段組を作ってる」
との事。んじゃ、とりあえず、手作業でやってみます。
印刷用のシートはSheet2とします。上のマージンや項目名を印刷することを考えて、データは２行目から表示するようにします。１ページに入る行数は、40行くらいにしておきます。
Sheet1のA2からB41までを選択し（C列はただ並べ替えのために使っているだけなので、印刷はしません）
それをSheet2のA2にコピーします。
次の40件、Sheet1のA42～B81まで選択して、 Sheet2のD2へコピーします。
１列開けたのは、印刷したときに段の間のスペースを調整できるようにするためです。
同じように、81件目以降もやっていきます。
横を5段以上にすると入りきらないので、最後の40件はA44から下に入っています。
ん、できました。後は印刷プレビューを確認しながらセル幅やセルの高さを調整したりしていけば、
ん、これは１枚目です。１段に40人ですから、１枚で40×4の160人分出ています。
200人分を２枚に収めることが出来ました(^^)。
しかし、激しくめんどくさいですね(^^;)
これだとデータが追加や削除されるたびに、印刷用のシートを１から作り直さなきゃいけないです。
んじゃ、この印刷用のシートを作るところをVBAを使って自動化できれば、少しは楽になるかな？
んでは、マクロを書いていきます。
「ツール」→「マクロ」→「Visual Basic Editor」でプロジェクトの中の「Sheet1」をダブルクリック、するとコードを記述するウィンドウが表示されます。
まずは何はともあれ、いつもやってるように全員のデータをイミディエイトウィンドウに表示させてみます。
イミディエイトウィンドウが表示されていない場合は、「表示」→「イミディエイトウィンドウ」で表示させます。
では、以下のプログラムをコードを記述する欄に書きます。
Sub test()
Dim lastgyou As Integer
Dim i As Integer
'Sheet1を選択します
Sheets("Sheet1").Select
'最後の人を求めます
ActiveSheet.Range("A2").End(xlDown).Select
lastgyou = ActiveCell.Row
'全員をイミディエイトウィンドウに表示します
For i = 2 To lastgyou
Debug.Print (ActiveSheet.Cells(i, 1).Value);
Debug.Print (ActiveSheet.Cells(i, 2).Value)
Next
End Sub
実行してみます。
ん、全員出ました(^^) これらの値をSheet2に書き出していけばよいわけですね。
今回は、最初の段はA列、B列の２行目からスタートして、A41、B41までの40行表示し、
次の段は、D列、E列の2行目からスタートして、D41、E41までの40行表示し、
３段目は、G列、H列の2行目からスタートして、G41、H41までの40行表示し、
４段目は、J列、K列の2行目からスタートして、J41、K41までの40行表示し、
５段目は、A列、B列の４４行目からスタートして、A83、B83までの40行を表示します。
さて、Sheet1を１行ずつ抜き出していって、それをSheet2のどこに表示すればよいか、それを求めなければなりません。
今回は、数式を使わずに、変数を用いて、どこに表示するかを求めていきたいと思います。
まず、Sheet1のコードの値をSheet2に表示する場所を 列をx、行をyとします。
1件目のデータは、x=1 (A列、つまり、左から１番目の列)、y=2 (2行目からスタートなので)となります。
2件目のデータは、x=1,y=3 3件目のデータは、x=1,y=4 ・・・ 39件目のデータは、x=1,y=40 40件目のデータは、x=1,y=41 です。
んでは、41件目は？ここで段が変わりますので、 41件目のデータは、x=4（D列、つまり左から4番目の列）,y=2 となります。
42件目のデータは、x=4,y=3 42件目のデータは、x=4,y=4 ・・・ 80件目のデータは、x=4,y=41です。
81件目でまた段が変わります。 81件目のデータは、x=7,y=2です。・・・ 121件目でも、段が変わります。
121件目のデータは、x=11,y=2です。・・・ 160件目のデータは、x=11,y=41です。
さて、161件目ですが、今回は横を４段までとしました。なので、これ以上、xの位置は増えません。
次のページの先頭に持っていきます。
161件目は、x=1,y=44となります。以下、200件目まで進み、最終的にx=1,y=83となります。
まとめると、こんな感じになります。
- x=1,y=2からスタート。
- 値を表示する。
- yを1つずつ足していって、41個目から、次の段へ進む。
- 次の段に進むと、xは3つ増える。ｙは上に40個戻る。
- 段が5つ目、9つ目、13つ目・・・（今回は5段までしかなりませんが）になったら、xを1に戻して、yを次のページの先頭に
なんか、複雑に見えますが、手作業でやるのと考え方に差はありません。プログラムにしてみると、
Sub test()
Dim lastgyou As Integer
Dim i As Integer
Dim dan As Integer
Dim x As Integer
Dim y As Integer
Dim code As String
Dim namae As String
'Sheet2を空にします
Sheets("Sheet2").Cells.Clear
'Sheet1を選択します
Sheets("Sheet1").Select
'最後の人を求めます
ActiveSheet.Range("A2").End(xlDown).Select
lastgyou = ActiveCell.Row
'段、横、縦の初期値を入れます
dan = 1
x = 1
y = 2
For i = 2 To lastgyou
'Sheet1を選択します
Sheets("Sheet1").Select
'code,namaeの変数に、コピーする値を代入します
code = ActiveSheet.Cells(i, 1).Value
namae = ActiveSheet.Cells(i, 2).Value
'Sheet2を選択します
Sheets("Sheet2").Select
'今の位置に値を代入します
ActiveSheet.Cells(y, x).Value = code
ActiveSheet.Cells(y, x + 1).Value = namae
'次の表示する位置を求めます
'まず、yを1つ増やします。
y = y + 1
'もし、yが42行目、84行目、126行目、・・・の場合
If y Mod 42 = 0 Then
'この場合、段が変わります
dan = dan + 1
'もし、段が、5段目、9段目、13段目、・・・の場合
If (dan - 1) Mod 4 = 0 Then
'この場合、ページが変わります。
x = 1
y = y + 2
Else
'そうでなければ、ページは変わりません。
x = x + 3
y = y - 40
End If
End If
Next
End Sub
やっぱり複雑ですかね？(^^;)
danという変数で、今何段目を表示しているかを記録しています。
yの値が、42で割り切れるとき、段が変わります。また、段数から1を引いた値が4で割り切れるとき、ページが変わります。
段が変わる際、ページが変わる場合は、yの値を2増やし、ページが変わらない場合は、yの値を40減らします。
では、実行してみます。さっき手作業で入れた、Sheet2のセルの中身を全部消して、プログラムを実行すると、、
ん、いい感じ(^^)
後は、印刷の調整は手作業でやってください。また、今回のプログラムは横4段、縦40行としていますが、これを変えるのであれば、プログラムに手を入れれば可能です。最後の青い部分の、modで余りを求める時の数字や、yに足す値を変えればOKです。
ここにアップしておきます→vbastudy_14.xls
http://www.simple-sys.com/blog/2008/03/22/97/
前の記事の。
http://q.hatena.ne.jp/1206174892
まず、COUNTIF関数。名前からして便利そうですね(^^)
「countif excel」で検索すると、こちらのページが見つかりました。
=COUNTIF(範囲,検索条件)
が使い方ですね。検索条件に、ただの値だけでなく、いろいろな比較式が使えて便利そうです(^^)。
4番目の回答者さんの式を参考に、COUNTIFを使って、そのAが何個目のAかを出してみます。 Sheet3のA2の計算式を以下のように直して、A8までコピーします。
=IF(Sheet1!B2=”A”,COUNTIF(Sheet1!B$2:B2,”A”),”")
もし、Sheet1のB列が「A」だったら、その行までに出現する「A」の数をカウントする、って感じですね。
ん、いい感じ(^^)
前の式だと、Aではない列にも値を入れておかなきゃいけなかったですが、こっちのほうがより美しい感じですね。
次は、COLUMN関数。
「column excel」で検索してみると、 こちらのページが見つかりました。
=COLUMN(範囲)
で、範囲を省略すると、その関数を設定したセルの列の番号が求められる、ということのようです。
さっき、Sheet2のVLOOKUP関数で、１つめのパラメータを入力するのが面倒だから、ということで、Sheet3のB1～P1まで数字を入れました（この作業をオートフィルというんですね。これも勉強になりました(^^) ） この作業もあんまり美しくないですが、COLUMN関数でうまいことできそうですね。 Sheet3の1行目はもう使いませんので、消しちゃいます。
んで、Sheet2のB1の計算式を以下のように直し、P1までオートフィルします。
=IF(ISERROR(VLOOKUP(COLUMN()-1,Sheet3!$A$2:$B$8,2,FALSE)),"",VLOOKUP(COLUMN()-1,Sheet3!$A$2:$B$8,2,FALSE))
そうすると、こんな感じ。
ん、できてますね(^^) B1のセルでは、COLUMN関数は2の値を返します。
このセルでは、1つ目の「A」の値を返す必要があるので、COLUMN()-1を探す値として使う、ということですね。
これまた、余計なセルを使わなくて済むようになりました。美しいですね(^^)
とりあえず、ここまでの内容でアップしておきます→vbastudy_0011.xls
あと、INDEXとMATCH関数。まず、MATCH関数ですが、 「excel match」で検索すると、こちらのページが見つかりました。
=MATCH(検索値,範囲 [,照合の型])
が使い方です。
範囲内で値を検索し、見つかった値が何番目に位置するかを数値で返す。
ということは、○こ目のAを探す時に使えそうですね。 同じく、今のページのすぐ下に、INDEX関数ものってます。
=INDEX(範囲,行位置,列位置 [,領域番号])
が使い方で、
範囲の中から、行位置と列位置を指定して値を取り出す
ということですから、これは動物の名前を抜き出すのに使えそうですね。 Sheet2のB1の式を以下のように直します。
=INDEX(Sheet3!$B$2:$B$8,MATCH(COLUMN()-1,Sheet3!$A$2:$A$8,0),1)
MATCH関数で、○こ目の「A」を、数値で探します。その見つかった値を使って、 INDEX関数で、抜き出してくる、という感じですね。
ということは、今、INDEX関数で、Sheet3のB列の範囲から抜き出してますが、このSheet3のB列って、VLOOKUP関数で使うためにコピーしたものですから、直接Sheet1を見るようにすれば、Sheet3にコピーする必要もなくなりますね。 Sheet3のB列を消して、Sheet2のB1の式を以下のようにします。
=INDEX(Sheet1!$A$2:$A$8,MATCH(COLUMN()-1,Sheet3!$A$2:$A$8,0),1)
んで、B1の式をP1までオートフィル。
ん、#N/Aが出てますが、B1~D1まではおっけい(^^) では、#N/Aを出ないようにします。 MATCH関数も一致するものがなかったらエラーになるのかな？ E2のセルに、
=MATCH(COLUMN()-1,Sheet3!$A$2:$A$8,0)
と入れてみると、
ん、エラーになるようです。ということで、B1のセルの式を
=IF(ISERROR(MATCH(COLUMN()-1,Sheet3!$A$2:$A$8,0)),"",INDEX(Sheet1!$A$2:$A$8,MATCH(COLUMN()-1,Sheet3!$A$2:$A$8,0),1))
とすると、
ん、いいんでないかい？(^^)
ここまででアップしておきます→vbastudy_0011_2.xls
あと気づいたのは、探すセルの範囲の指定方法です。
私の場合、あらかじめセルの範囲をA2～A8などと固定していますが、５番目の回答者さんは、 縦に行数が増えても問題ないような書かれ方をしていますね。
セルの範囲をA2:A8のように行数を指定してしまうと、行が増えたり減ったりしたき、面倒ですね(^^;)。 これを、A:Aのように記述すれば、Sheet1の行数が増えても、セルの範囲をいちいち直す必要はなくなりそうです。
Sheet2のB1の式を
=IF(ISERROR(MATCH(COLUMN()-1,Sheet3!$A:$A,0)),"",INDEX(Sheet1!$A:$A,MATCH(COLUMN()-1,Sheet3!$A:$A,0),1))
でC1～P1までコピー。 Sheet1にパンダを追加し、
Sheet3のA9のセルにA8の計算式をオートフィルし、
ん、4が入ってます。んで、Sheet2を見てみると、
ん、よいですね(^^)
ふぅ。以上で完成かな？とりあえず、アップしておきます→vbastudy_0011_31.xls
他の回答者さんの回答を見てみると、自分とは違う考え方でやったり、知らない関数が出てきたりしますので、自分で考えるときとは別の部分の脳を使ってる感じがします(^^;)
http://q.hatena.ne.jp/1206174892
「ワークシート関数だけでやる」ということで、「VBAのお勉強」じゃないですが(^^;)
質問者さんの「ワークエリア」という言葉の意味がちょっとわからなかったのですが、
「ワークエリア excel」で検索するとこちらのサイトが出てきました。
「一時的に用いられる記憶領域」という事ですね。
んじゃ、Sheet3を一時的に使ってみます。
さて。Sheet1からAの値を探して、Sheet2に値を出力すると言うことで。
ワークシート関数で何かを探すといったら、よく使うのはVLOOKUP関数ですね(^^)
VLOOKUP関数の書式は、「VLOOKUP関数」で検索すると、
こちらが見つかりました。
=vlookup(検索対象文字列,検索対象セル,抽出列,検索方法）
こんな感じですね。
んでも、これを普通に使ったんじゃ、複数の候補があった場合、最初の1つ目しか見つからないんじゃないかな？
VLOOKUPって、あんまり使ったことないので、ためしにやってみます。
Sheet1が
こんな状態だとします。
Sheet2のB1のセルで、VLOOKUPワークシート関数を使いたいのですが、
VLOOKUPで探すことが出来るのは、2つめのパラメータの「検索対象セル」の
左端の列だけなんですよね。。。ということは、このSheet1の形式ではB列の
値で検索したいので、使えません。
ということで、Sheet3に一時的に検索用にデータを入れてみます。
Sheet3のセルB1に
=Sheet1!B2
セルB2に
=Sheet1!A2
として、値をコピーし、その計算式を、8行目までドラッグします。
ん(^^)。これで、VLOOKUPを使えるような列の順番になりました。
とりあえず、A2~B8の範囲でA列で「A」の値を探してB列の値を返してみます。
Sheet2のB1のセルに、
=VLOOKUP(“A”,Sheet3!A2:B8,2,FALSE)
と入れてみます。
ん、とりあえずおっけい(^^)
1つめのパラメータが探したい値（”A”）、
2つめのパラメータが値を探すセルの範囲(Sheet3のA2からB8)
3つめのパラメータが見つかった行の値を返す列の番号（上で指定した範囲の中で、2列目の値を返す）
4つめのパラメータが、完全に一致するものを探す（FALSE）
という指定になっています。
ただ、、、B3の列で２つめのAの値をどうやって探すのか？
VLOOKUPワークシート関数には、「2つめに一致する行を探す」なんて機能はなさげですし。。。
探すセルの範囲を変える事はできますが、１つ前で見つかった次の行から探す？というのを、
どうやって指定すればいいか。。。
「1つめのA」、「2つめのA」、「3つめのA」という情報があれば、なんとかなるかな？
今あるのは、この情報ですから、ここでなんとか、
5行目のAが1つめのA、
6行目のAが2つめのA、
8行目のAが3つめのA
という事を導き出せば、VLOOKUPでなんとかなりそうです。
んじゃ、どうやって、5行目のAが1つめのAかを探すか、ですが。
頭の中で考えた場合、B列をB2から下に見ていって、
最初に見つかったAが1つめのA、
次に見つかったAが2つめのA、
その次に見つかったAが3つめのA
ということになります。
Aが見つかったら、値を一つ増やしてカウントしていく、、、これならなんとか計算式でできそう(^^)
分かりやすくするために、とりあえず、Sheet1でやってみます。
Sheet1のC2に
=IF(B2=”A”,1,0)
と入れて、B8までコピーします。
B列が「A」だったら1、そうでなければ0、という感じです(^^)
んで、D2に
=C2
D3には、
=C3+D2
と計算式を入れて、D3の計算式をD8までコピーすると、
こんな感じ(^^)。欲しい情報が得られました。
「Aが見つかったら1つ増やす」という列をD列に設けることで、
その行が上から何個目のAなのか、が分かるようになります。
後は、VLOOKUPワークシート関数を使って、
1つ目のA、
2つ目のA、
3つ目のA
って感じで探していけばいいですね(^^)
Sheet3でやってみます。とりあえず、今のSheet1のC列、D列と、さっき作ったSheet3の計算式は消しちゃいます。
Sheet3では、Aかどうかを判断する列とカウントする列を1つにまとめちゃいます。
Sheet3のA2に
=IF(Sheet1!B2=”A”,1,0)
A3に、
=IF(Sheet1!B3=”A”,Sheet3!A2+1,Sheet3!A2)
と入れて、A3をA8までコピーします。
B2に
=Sheet1!A2
として、B2をB8までコピーします。
ん、いいんでないかい？(^^)
A2の計算式は、
Sheet1のA2が「A」だったら1、そうでなければ0
という意味です。
A3の計算式は、
Sheet1のA3が「A」だったら、Sheet3のA2に1を足す、そうでなければ、Sheet3のA2の値そのまま。
という意味です。
A3の計算式をA8までコピーすることで、
Sheet1がAだったら１つ上のセルの値に1を足し、そうでなければ、1つ上のセルの値そのまま。
ということになります。
後は、Sheet2で、VLOOKUPワークシート関数を使うだけです。
Sheet2のB1のセルに、
=VLOOKUP(1,Sheet3!$A$2:$B$8,2,FALSE)
Sheet2のB2のセルに、
=VLOOKUP(2,Sheet3!$A$2:$B$8,2,FALSE)
Sheet2のB3のセルに、
=VLOOKUP(3,Sheet3!$A$2:$B$8,2,FALSE)
と入れると、、、
ん、よいようです(^^)
ただ、、、この計算式のままだと、１つめのパラメータ、
これは計算式をコピーしても1のままで変わらないので、いちいち手で直していかないといけないです。
めんどくさいですね(^^;)
ということで、Sheet3のB2からずっと右側に
こんな感じで、1からドラッグして値を入れておけば、Sheet2のB1の式を
=VLOOKUP(Sheet3!B1,Sheet3!$A$2:$B$8,2,FALSE)
とすることで、この式をC1以降にコピーしていけばよいですね(^^)
んでは、試しに、Sheet1のカバの値を「A」にしてみます。
すると、Sheet2は、、、
ん、いい感じ(^^)
ただ、D1までしか計算式を設定していないので、4つ目の値（ハシビロコウ）は出てないですね。
同じようにE1以降も計算式を設定すれば出るようになります。
E1～P1にも式をコピーしておきます。
(^^;) E1はきちんと出ましたけど、それ以降は・・・？
たぶんに、VLOOKUPワークシート関数で、5以降の値が見つからなかったということでしょう。
あまり美しくないので、#N/Aは出ないようにしたいですね。
「VLOOKUP #N/A」で検索すると、こちらのページが見つかりました。ISERROR関数を使うようですね。
B1の計算式を以下のように直します。
=IF(ISERROR(VLOOKUP(Sheet3!B1,Sheet3!$A$2:$B$8,2,FALSE)),"",VLOOKUP(Sheet3!B1,Sheet3!$A$2:$B$8,2,FALSE))
んで、この式をC1からP1までコピーすると、
ん、いいんでないかい？(^^)
いちおう、これで完成ということで。
Sheet1で行数が増えた場合、参照するセルの範囲が変わりますので、計算式が全部変わってくることになりますが、
たぶん、検索対象の範囲を指定する際に、セル範囲の名前を指定することが出来たと思いますので（やったことないですが(^^;)）
それを使えばいちいち計算式全部を直す必要はなくなると思います。
とりあえず、こちらにアップしておきます。vbastudy_0010.xls
3月 192008
http://q.hatena.ne.jp/1205765249
質問者さんのシート、これはシフト管理をするものなのかな？
左側のシートは、
「ある日のある人がどの当番に入っているか」
がわかる表で、これを、
「ある日のある当番が誰なのか」
を一覧にしたものが右側のシート、
と思われます。
質問者さんの左側のシート、1行目の数字が何を意味してるのかは
わかりませんが、日付としてみます。
2行目は曜日のようですが、これは右側のシートに出てきていませんので、
ここでは無視します。
とりあえず、5日までダミーで作ってたのがこちら。
これを右側の形に直すVBAを作ってみます。
まず、日付と思われる数字をいれちゃいます。
このシートでは5日までですが、何日まで入っているかわからないので、
1行目がどの列までデータが入っているかを調べてみます。
いつもは、縦（下）方向にデータが最後に入っている行を探していましたが、
今度は横（右）方向に調べてみます。
いつもの下方向は、
ActiveSheet.Range(“A1″).End(xlDown).Select
lastgyou = ActiveCell.Row
こんな感じ。
XlDownってなってるところが、下方向に探すところかな？
これを変えれば、右方向に探してくれると思うので、なんて変えればいいかを
調べてみます。
xlDown 右方向 で検索すると、
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_cell.html#xlup
のページが見つかりました。
xlToRightでいいみたいですね。
いつもはA1から下に調べていますが、今回は、B1から右に調べます。
Sub test()
Dim lastretu As Integer
Dim i As Integer
Sheets("Sheet1").Select
ActiveSheet.Range("B1").End(xlToRight).Select
lastretu = ActiveCell.Column
For i = 2 To lastretu
Debug.Print (ActiveSheet.Cells(1, i).Value)
Next
End Sub
lastretuという変数に、最終列が何列目かを入れるようにしました。
いつもの、
lastgyou = ActiveCell.Row
が
lastretu = ActiveCell.Column
となっています。アクティブのセルの列番号を取ってきています。
実行してみると、
ん、いい感じ(^^)
とりあえず、この値を結果のシートに入れちゃいます。
入れる場所なんですけど、列はAでいいんですが、行は何行目になるかを
計算しないといけないですね。
For ループで、iは2からlastretuまで変化します。
i=2の時（B2の時、つまり日付が1の時）、この「1」という日付の値をコピーする先は
Sheet2の2行目になります。
i=3の時（B3の時、つまり日付が2の時）、この「2」という日付の値をコピーする先は
Sheet2の5行目になります。
なんで5行目になるかですが、質問者さんが「各当番は最高３人まで」と書いていますので、
1日である当番の値は最大3行分です。というわけで、3行分開けた5行目が2列目の最初になります。
同じように
i=4の時、Sheet2の8行目、
i=5の時、Sheet2の11行目、
・
・
・
i=xの時、Sheet2の(x-2)*3+2 行目ですね(^^;)
Sheet2が結果のシートだとして、縦に入れていきます。
Sub test()
Dim lastretu As Integer
Dim i As Integer
Dim copydata As String
'1行目の最終列を求めます
Sheets("Sheet1").Select
ActiveSheet.Range("B1").End(xlToRight).Select
lastretu = ActiveCell.Column
'日付をコピーします
For i = 2 To lastretu
'コピーするデータをcopydataという変数に入れます。
Sheets("Sheet1").Select
copydata = ActiveSheet.Cells(1, i).Value
'Sheet2にデータをコピーします。
Sheets("Sheet2").Select
ActiveSheet.Cells((i - 2) * 3 + 2, 1).Value = copydata
Next
End Sub
コメントを入れてみました。copydataという変数を設けて、Sheet1から1つずつ抜き出して、Sheet2の該当するセルにコピーしていきます。
実行してみると、
ん、できてます(^^)
で、次。
Sheet1をAさんからIさんまで順番にSheet2にコピーしていきたいと思います。
まず、AさんからIさんまでを抜き出してみます。
これはいつもどおりですね。
Sub test()
Dim lastretu As Integer
Dim lastgyou As Integer
Dim i As Integer
Dim copydata As String
'1行目の最終列を求めます
Sheets("Sheet1").Select
ActiveSheet.Range("B1").End(xlToRight).Select
lastretu = ActiveCell.Column
'最後の人を求めます
ActiveSheet.Range("A3").End(xlDown).Select
lastgyou = ActiveCell.Row
'日付をコピーします
For i = 2 To lastretu
'コピーするデータをcopydataという変数に入れます。
Sheets("Sheet1").Select
copydata = ActiveSheet.Cells(1, i).Value
'Sheet2にデータをコピーします。
Sheets("Sheet2").Select
ActiveSheet.Cells((i - 2) * 3 + 2, 1).Value = copydata
Next
'最初の人から最後の人まで表示します。
Sheets("Sheet1").Select
For i = 3 To lastgyou
Debug.Print (ActiveSheet.Cells(i, 1).Value)
Next
End Sub
実行してみます。
ん、全員出ました(^^)
では、それぞれの人の当番を抜き出してみます。
これは先ほど見つけたlastretuの値を使って、抜き出せますね。
Sub test()
Dim lastretu As Integer
Dim lastgyou As Integer
Dim i As Integer
Dim j As Integer
Dim copydata As String
'1行目の最終列を求めます
Sheets("Sheet1").Select
ActiveSheet.Range("B1").End(xlToRight).Select
lastretu = ActiveCell.Column
ActiveSheet.Range("A3").End(xlDown).Select
lastgyou = ActiveCell.Row
'日付をコピーします
For i = 2 To lastretu
'コピーするデータをcopydataという変数に入れます。
Sheets("Sheet1").Select
copydata = ActiveSheet.Cells(1, i).Value
'Sheet2にデータをコピーします。
Sheets("Sheet2").Select
ActiveSheet.Cells((i - 2) * 3 + 2, 1).Value = copydata
Next
'最初の人から最後の人まで表示します。
Sheets("Sheet1").Select
For i = 3 To lastgyou
Debug.Print (ActiveSheet.Cells(i, 1).Value)
'各個人の当番を抜き出します。
For j=2 to lastretu
Debug.Print (ActiveSheet.Cells(i, j).Value)
Next
Next
End Sub
jの変数でループしています。
実行すると、
ん、Hさん、Iさんしか見えませんが、抜き出せていますね(^^)
これで、
いつ（jの値でわかります）、
誰が(iの値でわかります)、
何の当番か（Cells(i, j)のセルの値でわかります）
を、全てのセルに対して抜き出すことが出来ましたので、
上の値を使って、今度はSheet2にその情報を書き出していきます。
とはいえ、Sheet2のどこに何を書き出すのかは、単純な計算式などでは求まりません。
この部分のアルゴリズムがこのプログラムの肝になりそうです。
試しに、Aさんの情報を手動で、Sheet2に書き出す手順を考えていきます。
まず、Aさんの1日、これは「早番」です。
Sheet2は最初、
こんな状態です。
1行目には、当番を書きます。今回は「早番」を抜き出してきたので、
B1のセルに「早番」と入れます。
で、1日の「早番」はAさんである、という情報は、B2のセルに表現します。
とりあえず、これで1つ目の処理は終わりですね。
次、今度はAさんの2日について。今度は「遅番」です。
Sheet2の1行目に今度は「遅番」という情報を追加します。
C1のセルになりますね。
で、2日の「遅番」はAさんである、これは、C5のセルに表現します。
こんな感じ(^^)
次、Aさんの3日について。今度は「早番」です。
早番は、さっき1日の時に、B列に作っちゃいましたので、1行目は
何もしません。
で、3日の「早番」はAさんである、これは、C8のセルに表現します。
次、Aさんの4日について。今度は「普通」です。
これは今までには出てきていない当番なので、1行目に増やさないといけないですね。
3つ目の当番ですので、D1のセルになります。
で、4日の「普通」はAさんである、これは、D11のセルに表現します。
次、Aさんの5日について。「遅番」ですので、これはもうCの列に作ってあります。
5日の「遅番」はAさんである、これは、C14のセルに表現します。
これでAさんの情報は表示が終了しました。
同じようにBさん、Cさん・・・最後のIさんまでやっていきます。
さて、まず1行目の当番について。
これは抜き出したデータの当番が新しいものだったら（すでに出ている当番でなければ）、
どんどん右へ追加していく形でよいと思います。
どこに情報を出すのかを決める際、列は
・すでに出ている当番の場合は、その列に。
・今までに出ていない当番の場合は、最後の列に追加して、その列に。
で決めることが出来ます。
行は、どこになるでしょうか？
今、Aさんの情報を抜き出してきた時は、Aさんははじめの人ですから、
1日は2行目、
2日は5行目、
3日は8行目、
4日は11行目、
5日は14行目
と、すんなり書き出せましたけど、、、。
試しにBさんもやってみます。
Bさんの1日の当番は「遅番」です。列は、すでにC列にありますから追加する必要はありません。
で、1日の「遅番」はBさんである、これはC2のセルに表現します。
次、Bさんの2日の当番も「遅番」です。C列に書き出しますが、
2日はAさんも「遅番」です。
ということは、C5のセルはすでにAさんが入っていますから、その下に書き出さなければ
なりません。C6に入ることになります。
こんな感じですね。
ということで、抜き出した情報をどこに出すかですが、
・まず、当番の値で列を決める(今の例だと、Ｃ列)。
・その列で、何日目かにより、基準となる行を求める（今の例だと、5行目）。
・その列と行のセルに値が入っていなければ、そこに書き出す。入っていたら、その下を見る。
その下も入っていたら、さらにその下を見る、以下繰り返し。
って感じですね(^^;)
プログラムにしてみます。
Sub test()
Dim lastretu As Integer
Dim lastgyou As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim copydata As String
Dim nukidashihito As String
Dim nukidashitouban As String
Dim kakidashiretu As Integer
Dim kakidashigyou As Integer
'Sheet2をすべて空にしておきます。
Worksheets("Sheet2").Cells.Clear
'1行目の最終列を求めます
Sheets("Sheet1").Select
ActiveSheet.Range("B1").End(xlToRight).Select
lastretu = ActiveCell.Column
'一番最後の人を求めます
ActiveSheet.Range("A3").End(xlDown).Select
lastgyou = ActiveCell.Row
'日付をコピーします
For i = 2 To lastretu
'コピーするデータをcopydataという変数に入れます。
Sheets("Sheet1").Select
copydata = ActiveSheet.Cells(1, i).Value
'Sheet2にデータをコピーします。
Sheets("Sheet2").Select
ActiveSheet.Cells((i - 2) * 3 + 2, 1).Value = copydata
Next
'最初の人から最後の人まで抜き出します。
For i = 3 To lastgyou
'今から処理する人の名前をnukidashihitoに入れます
Sheets("Sheet1").Select
nukidashihito = ActiveSheet.Cells(i, 1).Value
'各個人の当番を抜き出します。
'jは2列目から最後の列までを表しています。
For j = 2 To lastretu
'その人のその日付の当番を nukidashitoubanに入れます。
Sheets("Sheet1").Select
nukidashitouban = ActiveSheet.Cells(i, j).Value
'nukidashitoubanの値から、どこの列に書き出すかを求めます。
'Sheet2をB1から右に見ていき、すでにあれば、その列に
'なければ､そのnukidashitoubanの値を追加して､その列にします｡
Sheets("Sheet2").Select
'書き出す列をＢ列（右から2つめの列）から探します。
kakidashiretu = 2
Do
'もし、すでにその列に同じ当番があったら、ループを抜ける
If ActiveSheet.Cells(1, kakidashiretu).Value = nukidashitouban Then Exit Do
'もし、何も書かれていないセルだった場合、新しい当番なので、
'そのセルにnukidashitoubanの値を入れ、ループを抜ける
If ActiveSheet.Cells(1, kakidashiretu).Value = "" Then
ActiveSheet.Cells(1, kakidashiretu).Value = nukidashitouban
Exit Do
End If
'１つ右のセルを調べる
kakidashiretu = kakidashiretu + 1
Loop
'何日目の情報を抜き出しているか( j の値・・・2～lastretuまで変化します)によって、書き出すセルの基準の行を決めます。
kakidashigyou = (j - 2) * 3 + 2
'書き出す基準となったセルを含めて、下に3つ分のセルの中から、開いている
'セルに値を代入します。どこも開いていなければ、何もしません
For k = kakidashigyou To kakidashigyou + 2
If ActiveSheet.Cells(k, kakidashiretu).Value = "" Then
ActiveSheet.Cells(k, kakidashiretu).Value = nukidashihito
Exit For
End If
Next
Next
Next
End Sub
一気に長くなっちゃいました(^^;)
まず、全ての処理を行う前に、Sheet2を空にしておきます。
赤い部分で、書き出す列を決めています。kakidashiretu を２から調べていき、
赤い部分を抜けた段階で、書き出す列の値がkakidashiretu に入っていることになります。
青い部分で、書き出す行を決めています。
Sheet1の列（ j ）の値を使って、まず基準となる行をkakidashigyouに入れます。
その後で、まず、kakidashigyou行目を見て、そこに値が入っていなければ、そこに当番の人を
書き込みます。For のループで、下2つ分で見つかるまで繰り返しています。
実行してみると、
いいんでないかい(^^)
これで一応完成かな？
Sheet1に入っている値によっては、問題が出る場合もあります。
例えば、「当番は3人まで」という条件以外のデータが入っていたりすると、4人目以降の人の情報は出ません。
また、例えば当番のない人（休みとか？）の場合、当番の値を空にするかもしれませんが、
その場合も正しく値が代入されません。
人数が増えても、当番の種類が増えても、このままのプログラムで問題ないですが、
「一日最大３人まで」の条件が変わる場合は、何箇所か手を入れる必要があります。
セルを求める式の掛け算の3の値と、最後のFor の K のTo のところの+2を変えれば、
大丈夫だと思います。
とりあえず、ここにおいておきます→vbastudy_0009.xls
