[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『同一の誕生日に複数の氏名を転記』（taka）
カレンダの該当する日付に、複数の誕生日の氏名を、自動転記する方法。
いつも勉強させていただいています。以前「複数のセルの内容を一つのセルに転記する方法」で質問させていただいてます。少しレイアウトを変えたのと、自分の考え方の整理のため再質問させていただきます。よろしくお願いします。 （やりたい事） 年と月を入力して自動作成されるカレンダの、該当する日付に、別シートから誕生日の氏名を自動転記させる。 （困っていること） 誕生日が同一の複数の氏名が転記できない。
レイアウト
シート１（カレンダ） Ａ Ｂ Ｃ Ｄ １ 2004 ２ 12 ３ 日付 曜日 誕生日の人数 お誕生日 ４ ５ ６ ～ ３４ Ａ１＝ユーザ設定０"年" Ｂ４＝WEEKDAY(A4,1) Ａ２＝ユーザ設定０"月" Ｃ４＝COUNTIF(シート２!A2:A8,A4)
Ａ４＝DATE（A1,A2,1)
Ａ５＝Ａ４＋１
シート２（誕生日データ）
Ａ Ｂ Ｃ Ｄ Ｅ Ｆ Ｇ Ｈ
1 参照年月日 月 日 カウント 順位 氏（３字）氏名（６字）生年月日
２
３
４
～
８
Ａ，Ｂ，Ｃ列はカレンダの日付と生年月日を参照させるための作業列
A2=DATE(シート１!$A$1,B2,C2)
B2=MONTH(H2) C2=DAY(H2) F2=LEFT(G2,3) Ｄ，Ｅは氏名を抽出するための作業列（Ｅ列は同一誕生日に順位をつけるもの） D2=IF(COUNTIF(シート１!A4:A34,A2)=0,0,1) E2=IF(D2=0,0,D2) E3=IF(E2=0,0,E2+D3) 以上のレイアウトでシート１のＤ４に入力する関数式を知りたいのです。 （失敗１）複数の誕生日の内一人しか転記できなかった。 D4=IF(COUNTIF(シート２!A2:A8,A4)=0,"",VLOOKUP(A4,シート２!A2:G8,6,0)) (失敗２）複数の同一誕生日に対応するため、同一誕生日の人に順位をつけてみた（シート２ Ｅ列）とりあえず、同一誕生日の人が二人とした。同一誕生日が二人の場合二名の氏名表示ができたが、一人の場合でも二名表示されてしまう。 D4=IF(C4>0,VLOOKUP(LAGE(シート2!E2:E8,1),シート2!E2:F8,2,FALSE)&"/"&VLOOKUP(LAGE(シート2!E2:E8,2),シート2!E2:F8,2,FALSE)&"さんの誕生日","") ここで止まってしまいました。LARGE関数の使い方がまずいのでしょうか。他に何かよい関数式はないでしょうか。ＶＢＡではどうすればよいでしょうか。ただしＶＢＡは只今勉強中です。
前回ご質問の時、少し考えたものです。
名前 誕生日 補助 あ 1980/10/3 10/3 =TEXT(B2,"m/d") い 1990/3/4 3/4 う 1960/11/5 11/5 え 1970/1/6 1/6 お 1965/10/3 10/3
で 10/1 10/2 10/3 10/4
=INDEX($A$2:$C$6,MATCH(TEXT(E$1,"m/d"),$C$2:$C$6,0),1)
今となっては参照範囲など、ばらばらのデタラメですからこのままではエラーが出ます。 とりあえず、考え方の参考です。（出せたとしても、１名だけです） 作業列をもっと使って OK なら、もしかして出来るかもしれません、、がダメだったらゴメンナサイ。
しかし、それ以上にシート１は通常のカレンダーではないのですか？ 単一セルに有るか無いかわからない [誕生日氏名欄] を作り 尚かつ複数有った時の為に２名、３名分のセル高、セル幅をあらかじめ作っておくのですか？ それとも、「無し」の時は通常セルで複数有った時に自動的にセルの大きさを調整出来るのでしょうか？ 一つのセルに「複数出したい」気持ちはわかりますが [私には] 現実的、実用的では無いような気がして、前回から疑問でした。
今回の（taka）さんの書き込みを余りよく見てませんので（若干アルコールが入ってます） 明日ゆっくり考えてみます。。が他の方が回答を出しているかもですね。 皆さん宜しくお願いします。では、お休みなさいませ。 （jun53）
おはようございます。 なんだかややこしそうなんで、ＶＢＡで考えてみました。 モノは試しです。一辺やってみておくんなはれ。
新しいブックにシート１、シート２を作ってみて下さい。（１、２の数字は全角で。 これ重要） シート１はあなたのフォーム通りに入力して下さい。 但しＣ列の関数は入力せんでも、マクロがやってくれますさかい、入力不要です。
次にシート２に下の表みたいに適当なデータを書き込んで下さい。 氏名は全角スペースで区切って記入して下さい。
A B
生年月日 姓名
1992/12/3 京都 五郎
1992/12/5 東京 三太郎
1990/1/15 徳島 香
1905/6/12 高松 三太夫
1995/12/28 北海道 道広
1995/12/3 木村 五郎
1905/4/8 島崎 実篤時宗
1988/12/3 魁 仁
1990/12/5 斉藤 充
1905/6/15 権堂 博
1905/6/15 中ノ原 恭三
1986/6/12 国木田 独歩
1988/12/28 畑山 宗典
1980/12/16 木塚 忠平
シート１のＤ列は適当な幅に拡げとって下さい。行は対処します。
次に [Alt]+[F11]でVBEを開いて下さい。 「シート１」を選択して、[F7]を叩きます。 真っ白なモジュールに（他にコードが出るかも知れまへんが、気ぃにせんでもよろしい で）下のコードをコピペして「Alt」+「Q」でエクセルに戻って下さい。
ゆっくり順序よくやってくださいよ。
これで準備完了ですわ。 あとはＡ２に適当な数字（シート２に該当する月）のみ打ち込んでみて下さい。
どうでっか？ 旨い事いきました？ あなたのシート２の要領が飲み込めませんのこんな案配になりましたけど、そこはまた コードをいじれば思い通りになると思いまっせぇ。 ほな...（弥太郎）
Private Sub Worksheet_Change(ByVal Target As Range)
Dim data, data_a, data_b
Dim tanjo ’ここ変更
Dim i As Integer, n As Integer ’変数の宣言
Application.EnableEvents = False ’イベントの一旦停止
If Target.Count > 1 Then Exit Sub ’複数行は目的以外なので中止
If Target.Address <> "$A$2" Then Exit Sub ’A2以外のセルだったら中止
Range("c4:d34").Clear ’C,D列のクリアー
Set ws1 = Worksheets("シート１")
Set ws2 = Worksheets("シート２")
With ws2
max_row = .Range("a2").End(xlDown).Row ’シート２のA列最下行を検索
For i = 2 To max_row ’2行目から最下行まで検索
data = Split(.Cells(i, 1), "/", -1)'i行目のデータを/で３分割
data_a = data(1) * 1 ’そのうちの月を数値で拾う
If data_a = Range("a2") Then ’それがA2と同じだったら
tanjo = Split(.Cells(i, 2), " ") ’スペースで名前を分ける
tanjo = tanjo(0) ’姓だけ取り出す
data = data(1) + data(2) ’3分割した月日を取り出す
With ws1
For n = 4 To 34 ’シート１の４行目から３４行目まで検索
data_b = Split(.Cells(n, 1), "/", -1)’ｎ行目を３分割
data_b = data_b(1) + data_b(2)’月日を取り出す
If data = data_b Then ’その日付がi行目と同一だったら
.Cells(n, 3) = .Cells(n, 3) + 1’人数の書き込み
.Cells(n, 4) = .Cells(n, 4) & tanjo & "さんのお誕生日です" & Chr(10) ’該当者の姓を書き込み
.Cells(n, 4).VerticalAlignment = xlTop ’上詰め
.Rows(6).EntireRow.AutoFit '←ここは削除しても良い
Exit For ’↑その行をオートフィット
End If
Next n
End With
End If
Next i
End With
Application.EnableEvents = True ’イベントを正常に戻す
End Sub
D4=IF(C4=0,"",IF(C4=1,VLOOKUP(LARGE(シート２!E2:E8,1),シート２!E2:F8,2,FALSE)&"の誕生日"、VLOOKUP(LARGE(シート２!E2:E8,1),シート２!E2:F8,2,FALSE)&"/"&VLOOKUP(LARGE(シート2!E2:F8,2),シート2!E2:F8,2,FALSE)&"さんの誕生日")) 抽出人数が二人の場合でこれだけながい数式になりました。もう少しスマートな関数式はできないでしょうか。（taka)
こんにちは。皆様ウィルス対策は万全ですか？ 今日、ウィルスソフトのバージョンアップで半日つぶれてしまいました。 旧番のアンインストールがうまくいかなかったのです。。と、それはさておいて、
むりやり関数で作ってみました。全然スマートではありませぬ。スミマセン 同日付は３人までです。
Sheet2 （誕生日データ）
A B C D E F G
1 氏名 生年月日 月日 件数 検索1 検索2 検索3
2 山本 太郎 1980/12/1 C2 D2 E2 F2 G2
3 大河内 三太郎 1990/12/4
4 椿 冬子 1960/12/3
5 鈴木 真澄 1970/12/2
6 徳川 健 1965/12/3
7 春日野 春男 1940/12/3
8 太田 三十郎 1977/12/4
C2 に =TEXT(B2,"m/d")
D2 に =COUNTIF(C:C,"="&C2)
E2 に =IF(D2>=1,LEFT(A2,FIND(" ",A2)-1),"")
F2 に =IF(ISERROR(VLOOKUP(C2,$C3:$E$8,3,0)),"",IF(D2>=2,VLOOKUP(C2,$C3:$E$8,3,0),""))
G2 に =IF(ISERROR(VLOOKUP(C2,$C3:$F$8,4,0)),"",IF(D2>=3,VLOOKUP(C2,$C3:$F$8,4,0),""))
で、下にコピー
姓と名は、全角スペースで区切る事です。半角なら修正して下さい。
VLOOKUP(C2,$C3:$E$8 の範囲と $ の有無に注意して下さい。
Sheet1 （カレンダー）
A B C D E F G
1 2004年
2 12月
3 月日 曜
4 2004/12/01 水 C4 E4 F4 G4
5 2004/12/02 木
6 2004/12/03 金
7 2004/12/04 土
C4 に =IF(COUNTBLANK(E4:G4)=0,E4&"さん "&F4&"さん "&G4&"さん ",IF(COUNTBLANK(E4:G4)=1,E4&"さん "&F4&"さん ",IF(COUNTBLANK(E4:G4)=2,E4&"さん ","")))
D列は、空き E F G は作業列です。
E4 に =IF(ISERROR(VLOOKUP(TEXT($A4,"m/d"),Sheet2!$C$2:$G$8,1,0)),"",IF(VLOOKUP(TEXT($A4,"m/d"),Sheet2!$C$2:$G$8,3,0)="","",VLOOKUP(TEXT($A4,"m/d"),Sheet2!$C$2:$G$8,3,0)))
F4 に =IF(ISERROR(VLOOKUP(TEXT($A4,"m/d"),Sheet2!$C$2:$G$8,1,0)),"",IF(VLOOKUP(TEXT($A4,"m/d"),Sheet2!$C$2:$G$8,4,0)="","",VLOOKUP(TEXT($A4,"m/d"),Sheet2!$C$2:$G$8,4,0)))
G4 に =IF(ISERROR(VLOOKUP(TEXT($A4,"m/d"),Sheet2!$C$2:$G$8,1,0)),"",IF(VLOOKUP(TEXT($A4,"m/d"),Sheet2!$C$2:$G$8,5,0)="","",VLOOKUP(TEXT($A4,"m/d"),Sheet2!$C$2:$G$8,5,0)))
"さん "等は、適当に修正して下さい。
IF の連打で申し訳ないです。 自分が勝手に思いこみで作ったので、ダメなら適当に捨てて下さい。 （jun53）
takaさんの、 D4=IF(C4=0,"",IF(C4=1,VLOOKUP(LARGE(シート２!E2:E8,1),シート２!E2:F8,2,FALSE)&"の誕生日"、、、、、、 の式、全然確かめてません、、ので ご希望とは違うかも知れませんし takaさんの式の方が優秀そうです。 わたしはこの辺が限界のようです。ごめんなさい。 （jun53）
上のコードに書式の説明を加えました。
tanjoでエラーが出るかも知れまへんのでDim tanjoに訂正して下はい。
ゲンカイ灘に見惚れてる（弥太郎）
「グフフ、グフフと笑ってるんです」この１節頭から抜けへん。
＞今日、ウィルスソフトのバージョンアップで半日つぶれてしまいました。
↑ ウィルス 作っちゃいけん、（正）ウィルス対策ソフト
アンチウィルスソフト です。 （jun53）
弥太郎さん、コードの解説とても助かります。何が書かれてあるのか、勉強します。実は手順のとおりしたつもりなのですがうまくいかず、そうこうするうちにフリーズして再起動のはめに陥りました。保存していなかったので、再度挑戦してみます。ところでコードの最先頭行は何が書かれているのでしょうか？私のWin-Meは最近不安定でどうしょうもないです。(taka)
無事解決したようですので、おまけ。
> 今日、ウィルスソフトのバージョンアップで半日つぶれてしまいました。 > ↑ ウィルス 作っちゃいけん、（正）ウィルス対策ソフト > アンチウィルスソフト です。 これは2003年[うっかりユニークで賞]をさしあげます。 私たちもついうっかり、こういう言い方をしています、反省。 私が見習わなくてはならないのは、 [jun53]さんが書き込んだ内容をきちんと見直しているということです。
（kazu）
なぜに見直すのでしょうか？ 書き込んだ当初はこれがベスト！と思っていても 時々 or いつも、とんでもない答えを書いていることが有るからです。 どうぞ、どうぞ見習わないで下さいませ。 （jun53）
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.