No.、氏名は一行ずつ、持ち物は1名に対して0～10程度の一覧がありま

質問

No.、氏名は一行ずつ、持ち物は1名に対して0～10程度の一覧があります。
１人１人は１行ずつあいております。
個人別の持ち物リストを作成したいのですが（日々50人程度）、フィルタだと個人の1行目の
持ち物しか抽出されません。
画像右側のようなリストには、ＶＢＡで番号から氏名持ち物を抽出させると
いいのでしょうか？？（No.を入力すると、氏名・持ち物の最後の行まで代入とか）
マクロでもできませんでした。。

No.と氏名をそれぞれの行に記入するのは運営上（複数人が入力）難しいです。

とても困っております。。
よろしくお願いいたします。

回答No.5

KURUMITO

回答Ｎｏ４です。大変失礼をいたしました。Ｄ2セルには次の式を入力して下方にオートフィルドラッグしてください。

=IF(AND(A2<>"",COUNTIF(E:E,A2)>0),MAX(D$1:D1)+1,IF(AND(C1<>"",C2<>"",D1<>""),MAX(D$1:D1)+1,""))

他の操作法はＮｏ4のとおりです。

回答No.4

KURUMITO

Ｄ列に作業列を作って対応するのがよいでしょう。
Ｄ2セルには次の式を入力して下方にオートフィルドラッグします。

=IF(AND(A2<>"",COUNTIF(E:E,A2)>0),MAX(D$1:D1)+1,IF(C2="","",MAX(D$1:D1)+1))

Ｅ2セルから下の行には抽出して表示させたいＮｏを例えば、Ｅ2セルに1、Ｅ3セルに3のように入力します。

Ｆ列からＨ列に抽出した表を表示させるとしてＦ2セルには次の式を入力してＨ2セルまでオートフィルドラッグしたのちに下方にもオートフィルドラッグします。

=IF(ROW(A1)>MAX($D:$D),"",IF(INDEX($A:$C,MATCH(ROW(A1),$D:$D,0),COLUMN(A1))=0,"",INDEX($A:$C,MATCH(ROW(A1),$D:$D,0),COLUMN(A1))))

これでＥ列に番号を入力すれば関連する表だけがＦからＨ列に表示されることになります。

回答No.3

imogasi

EXCELの表としての使い方に、反している。あえて言えば、ワード的なやり方になっている。
人間は質問のようなのが理解しやすいが、エクセルは
・行単位で（完結する）、
・その行にキーになる情報がある
・中間に空白行を置かない
「リスト」とか「テーブル」（それぞれEXCELの熟語で、一般的使用法に非ず）と言うのがそういうもので
そのようなデータの整理の仕方がEXCELに適している。
ーー
本件のシートを別シートコピーし
空白行を省き、氏名の下には氏名を入れて、フォントを白色にするVBAを書いておくから、そちらのほうで以後の応用を考えては。
例データ（－－は空白セル。左詰め表示されるのを防止の対策）
氏名 持ち物
山本 靴
ーー かばん

藤田 鉛筆

木村 消しゴム
ーー 筆

大野 ノート
ーー 帽子
ーーーー
標準モジュールに
Sub test01()
'---空白行削除
d = Range("B65536").End(xlUp).Row
For i = d To 2 Step -1
If Cells(i, "B") = "" Then Rows(i).Delete
Next i
'----氏名空白セルを補充
d = Range("B65536").End(xlUp).Row
m = Cells(2, "A")
For i = 3 To d
If Cells(i, "A") = "" Then '空白であれば
Cells(i, "A") = m '上と同じ氏名セット
Cells(i, "A").Font.Color = vbWhite '文字色白色
Else
m = Cells(i, "A") '氏名を覚えておく
End If
Next i
End Sub
実行結果　見かけ
氏名 持ち物
山本 靴
　　 かばん
藤田 鉛筆
木村 消しゴム
　　 筆
大野 ノート
　　 帽子
ーーーーー
これでフィルタなど出来る。大野でフィルタすると
ノートと帽子の行がでる。

回答No.2

mar00

Sub Macro1()

KENSAKU = Application.InputBox("No.または氏名を入力して下さい。")
On Error GoTo LINE:
Columns("A:B").Find(What:=KENSAKU).Activate

For i = ActiveCell.Row To ActiveCell.Row + 99
If IsEmpty(Cells(i, 3)) Then
Exit For
Else
Range(Cells(i, 1), Cells(i, 3)).Copy
GYOU = Cells(Rows.Count, 8).End(xlUp).Row + 1
Range("F" & GYOU).PasteSpecial
End If
Next i
Application.CutCopyMode = False
Range("A1").Select
Exit Sub
LINE:
MsgBox (" 該当者なし。")
End Sub

No.または氏名で検索してコピーするようになっています。
ボタンを作って、マクロを登録すればよいのではないかと思います。

回答No.1

aokii

氏名の右に行を追加して、2行目に=IF(B2="",C1,B1)をドラッグコピーして、値のみ貼り付け後に、持ち物をフィルタしては。

補足

こんにちは。
ご回答ありがとうございます。
今やってみたのですが、持ち物をフィルタするというのは
意味がわからないのですが、
すみません教えていただけますでしょうか？

行を挿入せずにできる方法があればうれしいです。