エクセル2007をつかっています。「会社で何月何日に、誰がどこへいったのか」がわかる表を作ろうとしています

質問

エクセル2007をつかっています。「会社で何月何日に、誰がどこへいったのか」がわかる表を作ろうとしていますが、
うまくつくれません。

シート１に以下のようなデータをつくり、

4月1日 佐藤 Aに訪問
4月2日 鈴木 Bに訪問
4月2日 加藤 Cに訪問

シート２のA1に「4月2日」と入力したら、このデータを参照して、A2とB2、A3とB３の
セルに、

4月2日
鈴木 Bに訪問
加藤 Cに訪問

と出力されるようにしたいのです。
INDIRECT、SMALL、ROWの機能をつかったり、いろいろ試してみたのですが、自分が素人なため、どうしてもうまくいきません。
どなたか詳しい方がいれば教えてください。よろしくお願いします

回答No.12

end-u

いろんな考え方があって面白いですね。
私も勉強になりました、ありがとうございます。

蛇足みたいなものですが
Option Explicit

Sub sample0() 'サンプルブック作成コード。
　　Dim ws　　As Worksheet
　　Dim fName As String

　　fName = Application.DefaultFilePath & "\TMP20100416.xls"
　　'DefaultFilePathにTMP20100416.xlsという名前のBookを作成します。
　　With Workbooks.Add(xlWBATWorksheet)
　　　　With .Sheets(1).Range("A1:C4")
　　　　　　.Rows(1).Value = [{"日付","担当者","訪問先"}]
　　　　　　.Rows(2).Value = [{"4月1日","佐藤","A"}]
　　　　　　.Rows(3).Value = [{"4月2日","鈴木","B"}]
　　　　　　.Rows(4).Value = [{"4月2日","加藤","C"}]
　　　　End With

　　　　'AdvancedFilter例は取り敢えず手動。
　　　　'A2セル値を入力後 Sub sample1() 実行。
　　　　With Sheets.Add
　　　　　　.Name = "AdvancedFilter例"
　　　　　　.Range("A1:A2").Value = [{"日付";"4月2日"}]
　　　　　　.Range("A3:B3").Value = [{"担当者","訪問先"}]
　　　　End With
　　　　.SaveAs fName

　　　　'パラメータクエリ例。
　　　　'A1セル変更時更新。基本的には手作業で設定できるのでマクロ不要。
　　　　'不正値対策は別途必要かな。
　　　　Set ws = .Sheets.Add
　　　　ws.Name = "QueryTable例"
　　　　With ws.QueryTables.Add(Connection:="ODBC;DSN=Excel Files;DBQ=" & fName, _
　　　　　　　　　　　　　　　　Destination:=ws.Range("A2"))
　　　　　　.CommandText = "SELECT [担当者], [訪問先] FROM [Sheet1$]"
　　　　　　.FieldNames = False
　　　　　　.RefreshStyle = xlOverwriteCells
　　　　　　.AdjustColumnWidth = False
　　　　　　.Refresh False
　　　　　　.CommandText = .CommandText & " WHERE ([日付]=?)"
　　　　　　With .Parameters.Add("日付", xlParamTypeDate)
　　　　　　　　.SetParam xlRange, ws.Range("A1")
　　　　　　　　.RefreshOnChange = True
　　　　　　End With
　　　　End With
　　　　ws.Range("A1").Value = "4月2日"
　　End With

　　Set ws = Nothing
End Sub

Sub sample1()
　　With ActiveWorkbook.Sheets("AdvancedFilter例")
　　　　.Parent.Sheets("Sheet1").Columns("A:C") _
　　　　　　　 .AdvancedFilter Action:=xlFilterCopy, _
　　　　　　　　　　　　　　　 CriteriaRange:=.Range("A1:A2"), _
　　　　　　　　　　　　　　　 CopyToRange:=.Range("A3:B3")
　　End With
End Sub

参考コードというより、サンプルBook。
一般機能の応用例として誰かの参考になればちょと嬉しいです:D
環境によってうまくいかなかったらスルーでお願いします。

お礼

ありがとうございます！できるようになりました！
本当にみなさんのおかげです。これを機にエクセルをもっと勉強してきます。本当にありがとうございました！

回答No.11

hige_082

シンプルに

SheetタブのSheet2を右クリック、コードの選択を選択
カーソルの位置へ下記マクロをコピペ
シートモジュールを閉じる

'Sheetモジュールへ
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i
If Target.Address = "$A$1" Then
Application.EnableEvents = False
Range("a2", Cells.SpecialCells(xlCellTypeLastCell)).ClearContents
With Worksheets("Sheet1")
For i = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
If .Cells(i, 1).Value = Target.Value Then _
.Cells(i, 2).Resize(, 2).Copy Cells(Rows.Count, 1).End(xlUp).Offset(1)
Next
End With
End If
Application.EnableEvents = True
End Sub

Sheet2のA1へ入力して試してみてください
但し、Sheet1のＡ列が日付としています

参考まで

回答No.10

1050 円（@1050YEN）

以下のコードを、
・「標準モジュールではなく」「Sheet2のマクロ」として張ると、そのままできます。

Option Explicit

'プロパティ：検索対象のシート
Property Get 検索シート() As Worksheet
　　Set 検索シート = ThisWorkbook.Worksheets("Sheet1")
End Property

'イベント：シート選択時
Private Sub Worksheet_Activate()
　　'シート選択時の更新が不要なら、この部分は要らない
　　Call Worksheet_Change(Me.Range("A1"))
End Sub

'イベント：値変更
Private Sub Worksheet_Change(ByVal Target As Range)
　　'念のため、空チェック
　　If Target Is Nothing Then
　　　　Exit Sub
　　End If

　　'セルがA1かどうかをチェック
　　Dim l_rngA1 As Range
　　Set l_rngA1 = Target.Cells.Item(1)
　　If (l_rngA1.Address(False, False) <> "A1") Then
　　　　Exit Sub
　　End If

　　'最初に結果をクリアする
　　Call 検索結果クリア

　　'からっぽ
　　If IsEmpty(l_rngA1.Value) Then
　　　　Exit Sub
　　End If

　　'検索を行っていく
　　Call 検索結果反映(l_rngA1.Value)
End Sub

'関数：検索結果クリア
Private Sub 検索結果クリア()
　　Dim l_rng2行目以降 As Range

　　'2行目以降の削除
　　Set l_rng2行目以降 = Me.Rows("2:" & Me.Rows.Count)
　　Call l_rng2行目以降.Delete
End Sub

'関数：検索結果反映
Private Sub 検索結果反映(ByVal p_検索値 As Variant)
　　Dim l_rng検索A列　　As Excel.Range
　　Dim l_rngSarch　As Excel.Range

　　Dim l_lng件数　 As Long
　　Dim l_lngRow　　As Long

　　'検索シートのA列を取得
　　Set l_rng検索A列 = Me.検索シート.Columns("A")

　　'A列だけに限定して検索（検索引数は自分でカスタマイズ）
　　Set l_rngSarch = l_rng検索A列.Find(p_検索値, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows)
　　If l_rngSarch Is Nothing Then
　　　　'一件もないので終了
　　　　Exit Sub
　　End If

　　Do
　　　　'現在の行を記憶
　　　　l_lngRow = l_rngSarch.Row

　　　　'カウントアップ
　　　　l_lng件数 = l_lng件数 + 1
　　　　Call 出力マクロ(l_rngSarch, l_lng件数)

　　　　'A列だけに限定して再検索
　　　　Set l_rngSarch = l_rng検索A列.FindNext(l_rngSarch)

　　　　'再検索結果が、先頭からの検索結果であれば抜ける
　　Loop Until (l_rngSarch.Row <= l_lngRow)
End Sub

'関数：出力マクロ
Private Sub 出力マクロ(p_rngSarch As Range, p_lng件数 As Long)
　　Dim l_rng出力先先頭 As Range
　　Dim l_rng出力先　　 As Range

　　'出力の先頭は、このシートのA2
　　Set l_rng出力先先頭 = Me.Range("A2")

　　'検索結果の件数目を考慮して、行を変更
　　Set l_rng出力先 = l_rng出力先先頭.Offset(p_lng件数 - 1)

　　'検索結果を出力していく
　　l_rng出力先.Offset(, 0).Value = p_rngSarch.Offset(, 1).Value
　　l_rng出力先.Offset(, 1).Value = p_rngSarch.Offset(, 2).Value
End

お礼

貴重な時間を使ってくださいまして大変ありがとうございます！！
このコードから、自分でいろいろ試してみたいと思います。
本当に、本当にありがとうございました！

回答No.9

p-211

貼り付けてみて思った

こぴぺしただけだと
インデントつかないんだな・・

コードが見にくくなってしまってる

ご勘弁を・・

回答No.8

p-211

オートフィルターじゃだめかな？
確かにそのままの状態だと不完全だけど　抽出データを見ることはできる

一応VBAだったら
下記のような感じになるが
プロシージャを書く場所とかコマンドボタンの配置、プロシージャの割り当て
なんかわからないだろう・・

考え方、手法は人それぞれだが・・

即席で作ってみた
貼り付けセル位置は適当なんでご勘弁

Sub テスト()
Dim i As Long
Dim cnt As Long
Dim Rastrow
Dim c As Range
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim Myday As Date
Dim Mydata() As Variant
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")

Myday = ws2.Range("a2").Value
Rastrow = ws1.Range("a2").End(xlDown).Row

cnt = 0
For Each c In ws1.Range("a2:a" & Rastrow)
If c.Value = Myday Then
cnt = cnt + 1
End If
Next c

ReDim Mydata(1 To cnt) As Variant
i = 1
For Each c In ws1.Range("a2:a" & Rastrow)
If c.Value = Myday Then
Mydata(i) = ws1.Range("a" & c.Row & ":b" & c.Row).Value
i = i + 1
End If
Next c

For i = 1 To cnt
ws2.Range("a" & i + 1 & ":b" & i + 1).Value = Mydata(i)
Next

End Sub

そういえば　”アノ方”はVBA、VBAと言いながらいつまでたっても
コードアップしないね・・。

回答No.7

_Kyle

●甲案：作業列と数式を使って素朴に。

１．シート１に作業列を作る

シート１のD1セルを
　=IF(A1=シート２!$A$1,ROW(),"")
として下方にフィル。

※該当する行にのみ行番号が表示されます。

２．シート２に結果を表示する

シート２のA2セルを
　=IF(COUNTIF(シート１!$A:$A,$A$1)<ROW()-ROW($A$1),"",INDEX(シート１!B:B,SMALL(シート１!$D:$D,ROW()-ROW($A$1))))
として右方,下方にフィル。

※ROW($A$1)の部分は、結果表示範囲の直上のセルを絶対参照で指定します。
※ROW()-ROW($A$1)の部分をROW(A1)のようにする人もいますが、コレは趣味の問題。

●乙案：数式一発で。

シート２のA2セルを
　=IF(COUNTIF(シート１!$A:$A,$A$1)<ROW()-ROW($A$1),"",INDEX(シート１!B:B,LARGE(INDEX((シート１!$A$1:$A$99=$A$1)/ROW(シート１!$A$1:$A$99),),ROW()-ROW($A$1))))
として右方,下方にフィル

●丙案：マクロで。

'-----↓　ココカラ ↓-------------------------------------------------
Sub Sample()

　Dim rtnRng As Range
　Dim keyDte As Date
　Dim orgAry As Variant
　Dim rtnAry As Variant
　Dim i　　　As Long
　Dim j　　　As Long
　Dim k　　　As Long

　'↓元データ範囲を指定
　orgAry = Worksheets("シート１").Range("A1:C999").Value
　'↓結果書出範囲を指定
　Set rtnRng = Worksheets("シート２").Range("A2:B999")
　'↓日付設定セルを指定
　keyDte = Worksheets("シート２").Range("A1")

　ReDim rtnAry(1 To rtnRng.Rows.Count, 1 To rtnRng.Columns.Count)

　For i = 1 To UBound(orgAry, 1)
　　If orgAry(i, 1) = keyDte Then
　　　k = k + 1
　　　For j = 2 To UBound(orgAry, 2)
　　　　rtnAry(k, j - 1) = orgAry(i, j)
　　　Next j
　　End If
　Next i

　rtnRng.Value = rtnAry

End Sub
'-----↑　ココマデ ↑-------------------------------------------------

※元データ範囲はとりあえず固定にしています。
　データ数に応じて動的に取得することもできますが
　この処理では少々余分に見てもたいした負担ではないので…。
※元データ第1列がソートされている必要はありません。
※列数が増えても元データ範囲、結果書出範囲の指定を広げればそのままいけます。

以上ご参考まで。

回答No.6

end-u

関数を使う方法だと、
【Sheet1】
　　Ａ　　　Ｂ　　　Ｃ
１　日付　　担当者　訪問先
２　4月1日　佐藤　　A
３　4月2日　鈴木　　B
４　4月2日　加藤　　C
：

例えば上記のようなセル位置関係だとして
【Sheet2】
B1　=MATCH(A1,Sheet1!A:A,0)
C1　=COUNTIF(Sheet1!A:A,A1)

という感じで作業用セルに数式を入れます。
あとは
A2　=IF(ROW()<$C$1+2,INDEX(Sheet1!B:B,$B$1+ROW()-2),"")
この式をB列及び必要行数分下へコピーすれば
一応お望みの形にはなります。
（Sheet1のデータが日付をキーに並べ替えてある事が条件です）

マクロで対応したいなら、前述例のようにSheet1の項目名をちゃんと設定し、
[フィルタオプション]を使うと良いです。
設定手順を[マクロの記録]すれば参考になると思います。

他の方法として、
自Book対象だけど[外部データの取り込み]を使えば、
パラメータ設定セルの変更時の自動更新ができるのでマクロも不要です。
ですがちょっと難易度があがりますので、自分が理解できる方法で取り組んでみて下さい。

回答No.5

Hardking

質問者は、最初からシート２で入力した日付で
別シートのシート１中から該当日付のデータを
シート２の指定したセルに出力したいと述べていますね。

質問者のスキルはわかりませんが、希望する内容
を実装するには、やはりＶＢＡを勧めます。

習得するまでは、手作業ですが必要なセル範囲をコピー
するのではいけませんか？
質問があれば回答しますので。

一旦習得しまえば、今後にも生かせます。

ＶＢＡ処理概要
１．シート１（データシート）Ａ列に訪問日付、Ｂ列に訪問内容を記す。
２．シート２へ検索するコマンドボタンを付加する
３．シート２のボタンが押下されたら、シート１Ａ列中より該当する
訪問内容がある分だけシート２の指定セルへデータ転記する。

回答No.4

p-211

出力先が固定セルならVLOOKUPでもいいと思うが・・
A1セルをリスト形式の入力規制を設定して
リスト範囲は日付の行にしていすればいいかと

回答No.3

Hardking

>知ったかぶりか自慢にしか思えない

知ったかぶりでは無く、実際ＶＢＡでの解決法を知ってんだよ！

>質問者は素人と自ら申告しているのに何でVBA？

素人はVBAできないのか？
素人でも十分独学でVBAできる人もいる。
周りにもそういう奴らはいっぱいいる。
回答に対して
それをする、しない、文句を言うは質問者のすること。
つまらん事を書くヒマがあるなら、質問者への回答なり
ヒントを考えてやれよ！

お礼

回答ありがとうございます。
VBAでも大丈夫です。（少々調べた程度なので、まだまだですが）
日付を入力したら、別のシートにある同日付の内容を
表示できるようにしたいのです。
よろしくおねがいします。