ExcelVBA シートを順番に検索して値をセット

質問

よろしくお願いします。
Excel VBAで以下のことをやりたいと思っていますが、どうにもこうにもうまくいきません。

勤怠管理表を作成しています。
シートの構成は田中次朗、鈴木一郎、など一人一人の勤怠を入れるシートと提出用合計シートから成り立っています。
普段、手で入力をするのはあくまでも田中次郎さんや鈴木一郎さんなどの一人ずつのシートで、提出用の合計シートは、各シートから値をコピーして貼り付けるというマクロをつくり、提出用合計シートは自動的に出来上がるようにマクロを組みたいと考えています。

なので、提出用合計シートでマクロを実行すると、まずは、提出用のシートの名前を上から検索して、田中さんだったら、対象の田中さんのあるシートを検索、その後、田中さんのシートから該当箇所をコピーして提出用のシートに貼り付け→その後鈴木さんだったら、鈴木さんはどこのシートにあるかを検索して、コピーして貼り付け…の順番にやりたいです。

提出用のシートは、左側の画像Book２のように、A列に鈴木さんの番号がついています。そのためこの鈴木さんの番号（A4の値）がBook１のようにB2に入っているので、鈴木さんのシートのB2を見つけるというマクロがまず必要になると思います。（全部のシートを総当たりするということ？）
その後、見つかったら鈴木さんのシートをアクティブにして、開始の時間は縦に31日分入っているので、それをコピーして、提出用のシートに行列を入れ替えて貼り付けを行う。次に、終了時間をコピーして提出用に貼り付け…
その後、田中さんの番号を提出用のシートから見て、田中さんのシートはどこですか？と探し…を繰り返したいと考えています。

うまく表現できていませんが、Find関数とかを使えばいいのでしょうか？
最初の提出用のシートにある個別の番号が、どこのシートにあるか、そのシートをアクティブにするかという部分で躓いています。
よろしくお願いいたします。

回答No.3

m3_maki · ベストアンサー

こんにちは。

> その後、田中さんの番号を提出用のシートから見て、田中さんのシートはどこですか？と探し…を繰り返したいと考えています。

これは、ちょっとどうかと思います。
個別用の、コードから、提出用の A列 を検索して 貼り付ける位置を決定するのが簡単でしょう。

質問者さんの仕様がブレているので、決定的にこうとは言えませんが
最初の図のとおり
ブックは 「個別用」 と 「提出用」 の２つ、
名前は 拡張子なしの 「Book1」「Book2」
どちらも開かれていること。
以下、個別用のシートの分、くりかえす。
　　「個別用」 の "B1" の コード を 「提出用」 の A列から検索。

　　見つかったら 「個人用」 の 時刻の部分 をコピー
　　行列を入れ替えて、見つけた位置の２カラム右に貼り付け。

マクロは 「提出用」 にあるものとします。 （これを変えるのは簡単です。）
妥当性のチェックはしていません。
シート名とコードの整合性チェックなど、必要なら処理を加えてください。

あくまで例ですので、最低限の機能になっています。
----------------------------------------
Option Explicit

Dim Logging As String

Sub 提出用作成()
'
　　Dim wsh As Worksheet
　　Dim rng As Range
　　Dim found As Range

　　Set rng = ThisWorkbook.Worksheets("提出用").Columns(1)

　　Logging = ""

　　For Each wsh In Workbooks("Book1").Worksheets

　　　　Set found = rng.Find(What:=wsh.Cells(1, 2), LookIn:=xlValues, LookAt _
　　　　　　:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
　　　　　　False, MatchByte:=False, SearchFormat:=False)

　　　　If found Is Nothing Then
　　　　　　Logging = Logging & "," & wsh.Name
　　　　Else
　　　　　　wsh.Range("C5:D9").Copy　　'　１カ月は５日です。（最初の図の通り）
　　　　　　found.Offset(0, 2).PasteSpecial Paste:=xlPasteValues, Transpose:=True
　　　　　　Application.CutCopyMode = False
　　　　End If

　　Next

　　If Logging <> "" Then
　　　　MsgBox Mid(Logging, 2) & " はコピーされませんでした"
　　End If

End Sub
-----------------------------------

No.2 さんへの補足より

> プログラム用のファイルを別に作成するということが可能なのですか？

可能です。
例えば、上記プログラムを 「Book3」 に作成しておき、
３つとも開いておきます。

この場合
　　Set rng = ThisWorkbook.Worksheets("提出用").Columns(1)
の部分を
　　Set rng = Workbooks("Book1").Worksheets("提出用").Columns(1)
に変更します。

> 提出用も個別用も１０ファイルずつあります。

更にファイル名や保存パスに規則性があったり、変更されない場合とか
プログラムのブックに ファイル名（フルパス） の対応表を作ってある場合など、
プログラムのブックだけを開いて、自動的に他のファイルを開くことも可能です。

> リンク先にも同様に質問をいたしますが

少なくともあちらは、マルチポスト禁止です。
あちらに質問するなら、こちらはきちんと閉じてください。

私なども、マルチポストだと分かったら、レスしないことにしています。

お礼

まずは、私のつたない質問にお答えいただいて本当にありがとうございます！
明日、さっそく自分で作成して応用できるかやってみたいと思います。
うまくいかなかったときには、ぜひまたアドバイスをいただければと思います。

また、
>更にファイル名や保存パスに規則性があったり、変更されない場合とか
>プログラムのブックに ファイル名（フルパス） の対応表を作ってある場合など、
>プログラムのブックだけを開いて、自動的に他のファイルを開くことも可能です。
こちらがとても興味あります。
まずは第一段階として、教えていただいたことをうまく生かせたら、その後できたらこのあたりも教えていただきたいなぁと思います！

なぜならこの後、さらにチームが増え、ファイルはどんどん増える予定なのです…。

>少なくともあちらは、マルチポスト禁止です。
はじめてこちらのサイトを拝見しましたが、もちろん礼儀はわきまえるつもりです。また、こちらのサイトでは具体的に自分で作成したコードをもとに
emuanchaさんもおっしゃっていましたが、みていただく場所かな？と思いますので、もう少し勉強してから、こちらももちろんクローズしてからにするつもりです。

まずはご丁寧に、このような状況にもかかわらずご指導いただきましてありがとうございました！感謝いたします。

補足

おかげさまで無事にプログラムが完成しました。
本当にありがとうございました！
おふた方にベストアンサーを差し上げたいのですが、詳しくコードを書いていただいたm3_makiさんにベストアンサーをしてクローズさせていただきます。
おかげさまでずいぶん勉強させていただき無事に完成しました。
とても作業が効率よくなりました。
あとはファイルが変わってもできるような状況にこれからまた勉強したいと思います。
本当にありがとうございました！

回答No.5

emuancha

No.2です。

m3_makiさんに適切な補足をしていただいたようです。m_o_m --> m3_makiさん

> プログラム用のファイルを別に作成するということが可能なのですか？

その方が，メンテナンスがやり易いです。
また，プログラム用のブック（マクロブックとしましょう）にconfigと言うシートを一つ作って，対象となるファイル名（ブック名）を，たとえばA1セルから順に（横でも縦でも）記載しておけば，ファイル名に規則性が無くても対応できます。

> リンク先にも同様に質問をいたしますが、できれば、ブックを別にするほうほうなど教えていただければ幸いです。

mougに質問する時は，問題点を抜き出して小さなプログラムにしておくとより速くアドバイスが期待できます。冗長なコードでは，読みたくなくなることもあります。

お礼

emuanchaさん、本当にありがとうございます。
m3_makiといいお二人ともとてもお詳しくて本当に尊敬いたします。

>プログラム用のブック（マクロブックとしましょう）にconfigと言うシートを一つ作って，
>対象となるファイル名（ブック名）を，たとえばA1セルから順に（横でも
>縦でも）記載しておけば，ファイル名に規則性が無くても対応できます。

すごいです！そんなことができるのですね！！
ぜひやりたいです。

というのもチームはこれから毎月増えて行きます。
おそらくこれから際限なく増えていくため
そういった方法が確実に必要だと感じているためです…

そのような方法ができるようになりたいです…
下記の状況がクリアになりましたら、ぜひ、また教えていただきたいものです。今後ともぜひ教えてくださいますようよろしくお願いいたします。

mougのサイト、拝見いたしました。
すごいサイトがあるものですね！感心いたしました！

回答No.4

m3_maki

No.3 です。
ちょこっと修正 --;

> この場合
> 　　Set rng = ThisWorkbook.Worksheets("提出用").Columns(1)
> の部分を
> 　　Set rng = Workbooks("Book1").Worksheets("提出用").Columns(1)
> に変更します。

この場合
　　Set rng = ThisWorkbook.Worksheets("提出用").Columns(1)
の部分を
　　Set rng = Workbooks("Book2").Worksheets("提出用").Columns(1)
に変更します。

「提出用」 は　Book2 でしたね。

お礼

下記にあわせてお礼を記入させていただきました。
本当にありがとうございます。

回答No.2

emuancha

こんにちは。

そんなに難しいプログラムではないように感じます。
私ならば，提出用と個別用のシート（ブック？）とは別にプログラム用のブックを作り，提出用のブック（シートでも良いけど）を作り出します。
関数など使わなくても単純にセルの内容比較だけで出来そうですけど・・・。基本的には，if文で出来ると思います。

どんなコードを書いているのかを添付した方がアドバイスが得られやすいでしょう。その前に仕様を整理したら良いです。ここよりも以下の方がより適切なアドバイスを得られますよ。
http://www.moug.net/faq/viewforum.php?f=2

補足

ご回答をありがとうございます！
ぜひ詳しくお話を聞かせていただきたいです。

まさにやりたいのはそれなのです。
今までは、提出用のシートに直接打ち込んでいて、間違いが多いため、今回から個別用のシートを別に作ることにしたのです。
そして、提出用のシートはあくまでも結果をコピーして貼り付けるだけのブックにしたいのです。
おっしゃるように提出用と個別用は本当はブックを分けたいと思っています。さらにいえば、10チームほどチームが分かれているので、提出用も個別用も１０ファイルずつあります。
プログラム用のファイルを別に作成するということが可能なのですか？
私はVBAがあまり詳しくないので見よう見まねで作っているものですごく躓いてしまいます。

リンク先にも同様に質問をいたしますが、できれば、ブックを別にするほうほうなど教えていただければ幸いです。
ぜひくわしく教えてください。
よろしくお願いします。

回答No.1

tsubuyuki

どうしてもマクロでやりたいならアレですけど・・

例えば、
・「山田太郎」と言う文字列が、A1セルに入っている
・「山田太郎」と言うシートのB5セルを参照したい
と言う条件であれば、

=INDIRECT(A1&"!B5")

と言う関数で出来ますよ。
この場合、参照先が空白の時は０（ゼロ）を返してきます。
それがアレだと言うのであれば、IF関数などで工夫が必要ですけどね。

補足

さっそくありがとうございます！
私もINDIRECTを考えたのですが
人数が100名以上いて、次の人に組むことを考えると…＞＜
どうなんでしょう…。