エクセル 初心者。

質問

エクセルで「全シートから、指定した日付と入力文字を検索し
その入力文字がある場合、指定のシートに情報を返す」ということはできるのでしょうか？

例えばですが…
日付　　来客名　　担当　　売上　　現金　　未払い
4/2　　AAA　 　山下　　2000　 1000 1000

こんな表で「山下」を全シートから
検索して、日付と来客名と売り上げと現金と未払いの情報を
別のシートに列単位で順に羅列するというようなことです。

マクロでも関数でもいいのですが
こういった場合はどのようにすればよいのでしょうか？
初心者の質問で理解しづらいかと思いますが
わかる方御教え願えますでしょうか？

よろしく御願いします。

回答No.7

keithin

シートまたいでとかでは、関数で行うのは現実的じゃありません。

手順：
ＡＬＴ＋Ｆ１１を押す
現れた画面で挿入メニューから標準モジュールを挿入する
現れたシートに下記をコピー貼り付ける

sub macro1()
　dim who as string
　dim w as worksheet
　dim c as range
　dim c0 as string

’誰を集計するのか問う
　who = inputbox("WHO")
　if who = "" then exit sub

’シートを準備する
　on error resume next
　application.displayalerts = false
　worksheets(who).delete
　application.displayalerts = true
　worksheets.add after:=worksheets(worksheets.count)
　activesheet.name = who

’各シートの「Ｃ列」から集める
　for each w in worksheets
　if w.name <> who then
　　with w.range("C:C")
　　set c = .find(what:=who, lookin:=xlvalues, lookat:=xlwhole)
　　if not c is nothing then
　　c0 = c.address
　　do
　　　c.entirerow.copy worksheets(who).cells(range("C65536").end(xlup).row + 1, "A")
　　　set c = .findnext(c)
　　loop until c.address = c0
　　end if
　end with
　end if
　next

’以下はオプション
　range("C:C").delete shift:=xlshifttoleft
　worksheets(1).range("1:1").copy range("A1")
end sub

ファイルメニューから終了してエクセルに戻る
マクロを実行する。

＃あなたの「たとえば」に応じた例えばのマクロです。
ご自分のエクセルの「正しい姿」に合致するよう、当然ですがご自分ででキチンと手直して利用してください。

補足

ご回答ありがとうございます。

すごく理想に近いように仕上がりました！

不躾で申し訳ないのですが
もう少し教えて頂きたいのですが

・このVBAだと新たにファイルが出来てしまうのですが
指定したシート名にコピーはどのようにして行うのでしょうか？
・こちらの表の隣に違う表があるため（雑費などの計算表）
コピーする範囲をしていしたいです。
・こちらを実行すると、同時にシート内の指定範囲２カ所もコピーしたいのですが
（片方は教えて頂きました名前を特定する範囲ともう片方は単純にセルを指定してコピー）
上のVBAに追加でできるのでしょうか？

初心者のため説明自体が解りづらいかと思いますが
すごく解りやすくしていただいたので
もう少しお付き合いいただけましたら幸いでございます。

回答No.6

tom04

No.4・5です。

補足に
＞計算表は１日集計にしております。
（シート１が１日の売り上げ、シート２が２日の売り上げ）

とありますが、一番肝心なところです。
どのSheetに書き出すか？によって当然コードは変わってきます。
補足にも「どのSheetに書き出すか」が明記されていませんので、
一応最後のSheetに書き出す場合のコードにしてみました。

Sub Sample2() 'この行から
Dim i As Long, k As Long, str As String, wS As Worksheet
Set wS = Worksheets(Worksheets.Count) '←Sheet見出しの最後のSheet
i = wS.Cells(Rows.Count, 1).End(xlUp).Row
If i > 1 Then
wS.Rows(2 & ":" & i).ClearContents
End If
str = InputBox("担当者名を入力してください。")
For k = 1 To Worksheets.Count - 1 '←Sheet見出しの一番左側から最終Sheetの一つ前まで
With Worksheets(k)
.Range("A1").AutoFilter field:=3, Criteria1:=str
i = .Cells(Rows.Count, 1).End(xlUp).Row
If i > 1 Then
.Rows(2 & ":" & i).Copy wS.Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
.AutoFilterMode = False
End With
Next k
End Sub 'この行まで

※　VBAの場合Sheet順・各シートの行・列の配置が一つ違っただけでも
めちゃくちゃな表示になってしまいますので、実際のデータに合わせて適宜変更してみてください。m(_ _)m

回答No.5

tom04

No.4です。

画像の添付を忘れていました。
どうもごめんなさい。m(_ _)m

回答No.4

tom04

こんにちは！
VBAでの一例です。

検索結果を表示させるSheetはSheet1で
Sheet見出しの2番目以降にデータがあるとします。

Alt＋F11キー　→　メニュー　→　挿入　→　標準モジュール　→　VBE画面に
↓のコードをコピー＆ペーストしてマクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

尚、全Sheetとも↓の画像のようにレイアウトになっているという前提です。

Sub Sample1() 'この行から
Dim i As Long, k As Long, str As String, wS1 As Worksheet
Set wS1 = Worksheets("Sheet1") '←「Sheet1」は実際のSheet名に！
i = wS1.Cells(Rows.Count, 1).End(xlUp).Row
If i > 1 Then
wS1.Rows(2 & ":" & i).ClearContents
End If
str = InputBox("担当者名を入力してください。")
For k = 2 To Worksheets.Count
With Worksheets(k)
.Range("A1").AutoFilter field:=3, Criteria1:=str
i = .Cells(Rows.Count, 1).End(xlUp).Row
If i > 1 Then
.Rows(2 & ":" & i).Copy wS1.Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
.AutoFilterMode = False
End With
Next k
End Sub 'この行まで

こんな感じではどうでしょうか？m(_ _)m

補足

丁寧な解説誠に感謝致します。

説明でいい忘れておりましたが、
計算表は１日集計にしております。
（シート１が１日の売り上げ、シート２が２日の売り上げ）

この場合でも同じ記述でできますでしょうか？

回答No.3

k-josui

質問を斜め読みですが、単純にピボットテーブルでできませんか？
この方が余程簡単ですが・・・

http://www4.synapse.ne.jp/yone/excel2010/excel2010_pivot1.html
http://hamachan.info/excel/piboto.html

回答No.2

KURUMITO

関数で対応するのでしたら次のようにします。
マクロの場合と違って関数の場合には各シートにデータが追加されれば自動的にまとめのシートにデータが反映されます。
例えばシート1からシート3にデータが有るとして、山下のデータをシート4にまとめて表示させるとしたら次のようにします。
シート1からシート3までのシート見出しをＣｔｒｌキーを押しながらクリックします。これでシート1からシート3までが作業グループになります。そこでＨ2セルに次の式を入力して下方にドラッグコピーします。

=IF(C2="","",C2&COUNTIF(C$2:C2,C2))

次にまとめのシートのＡ1セルには担当の文字を入力し、Ｂ1セルには山下などの担当名を入力します。
Ｂ2セルから右横方向にはＳｈｅｅｔ１，Ｓｈｅｅｔ２などとシート名を入力します。
Ｂ3セルには次の式を入力して右横方向にドラッグコピーします。

=IF(B2="","",COUNTIF(INDIRECT(B2&"!C:C"),$B$1))

各シートに担当者名の行が何行あるのかが表示されます。
Ａ4セルには0を入力します。Ｂ4セルには次の式を入力して右横方向にドラッグコピーします。

=IF(B3="","",A4+B3)

以上でお望みの表を作成するための準備作業は終わります。
Ａ6セルから右横方向にはシート1などでの項目名をコピーして貼り付けます。
Ａ7セルには次の式を入力して右横方向にドラッグコピーしたのちに下方にもドラッグコピーします。

=IF(OR(ROW(A1)>MAX($4:$4),A$6=""),"",INDEX(INDIRECT(INDEX($2:$2,MATCH(ROW(A1)-0.1,$4:$4,1)+1)&"!A:F"),MATCH($B$1&(ROW(A1)-INDEX($4:$4,MATCH(ROW(A1)-0.1,$4:$4,1))),INDIRECT(INDEX($2:$2,MATCH(ROW(A1)-0.1,$4:$4,1)+1)&"!H:H"),0),COLUMN(A1)))

A7セルから下方にはシリアル値が表示されますのでそれらの行を右クリックして「セルの書式設定」の「表示形式」からお望みの日付に変更します。

回答No.1

soixante

マクロで対応可能でしょう。

シート1から100までデータが入っているとし、
アウトプットするシートをシート999とするならば、

For i=1 to 100　でシート１から100まで回し、
その中に
Do while ～Loop　で、最終行まで「山下」を検索し、
それで、
If ～　then で、山下にヒットしたら、
シート999の最終行
Worksheets("Sheet999").Cells(Rows.count,1).End(xlup).Row+1
にコピペしたらいいんではないでしょうか。

なお、Application.ScreenUpdating はFalseにしといたほうがいいと思います。

補足

ご回答ありがとうございます。

おそらくある程度使える人にはわかるように
書いて頂いてると思うのですが
お手数でなければ、実際にVBAに記述する
書き方で書いて頂けませんでしょうか？