別シートの値を検索して一致したものを合計する

excelvba初心者です。
お手数おかけします。
難問なのかどうかもよく分からず。。困っています。


シート１　　　　　　　シート２ 　 シート３
AAA 100　　　　　AAA ５０　　　　　　BBB 20
BBB　200 　 CCC　150 　 CCC 30
DDD　300 　 QQQ 250 　 DDD 10
EEE 400 　 　 WWW 350 　RRR 40


上記の値を決められた順番に別シートに集計したい(その時に、値を1/10にしたい）

シート４
AAA 150
BBB 220
CCC 180
DDD 310
EEE 400
FFF 0
GGG 0
www 350

findでAAAを検索し見つかった値を ifにて条件分岐させるものをつくったものの
プロシャーシーが大きすぎと言われてできません。

どなたか教えていただけないでしょうか。

No.3 ベストアンサー 回答者： ap_2 回答日時： 2013/02/04 08:38

てきとーだけど、分かりやすく書いたつもり・・・

ステップ実行やローカルウィンドウ使って、確認してください。「確認用」の行は消していい。VBEのヘルプ（FindNextで検索）にサンプルコード載ってることもあるから、見てみるといいかも。

Sub zzz()
　Dim sh_mst As Sheet, sh As Sheet
　Dim rng As Range, c As Range
　Dim r, n
　Set sh_mst = Sheets("マスター")
　'マスターループ
　r = 1
　Do While sh_mst.Cells(r, 1) <> ""
　　skey = sh_mst.Cells(r, 1)
　　n = 0
　　'シートループ
　　For Each sh In Sheets
　　　If sh.Name <> "マスター" Then
　　　　sh.Select　　 '確認用
　　　　'--> 検索処理
　　　　Set rng = sh.Range("A:A")
　　　　Set c = rng.Find(skey, LookIn:=xlValues)
　　　　If Not c Is Nothing Then
　　　　　c.select　　'確認用
　　　　　firstAddress = c.Address
　　　　　Do
　　　　　　n = n + c.Offset(0, 1).Value
　　　　　　Set c = rng.FindNext(c)
　　　　　　c.select　'確認用
　　　　　Loop While Not c Is Nothing And c.Address <> firstAddress
　　　　End If
　　　　'<-- 検索処理
　　　End If
　　Next 'sh
　　sh_mst.Cells(r, 2) = n / 10
　　r = r + 1
　Loop 'sh_mst
End Sub

この回答へのお礼

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

わかりずらい返信に対し理解していただき
感謝しております。
なにぶんにも、素人なもので。。もっともっと出来るように
ならなくてはと。。。

今回のいただいたプログラムにより出来そうです。
あとは、今作っているやつに自分でアレンジしていけばと思います。

今回１列のみの計算ですが、２列を対象にして計算させるにはとか。。まだまだ分かりません。
今から勉強することは山積みですが、一度いただいたものをアレンジして
挑戦していきたいと思います。

どうしても分からない場合は、再度、質問させていただきますので
その時は、よろしくお願い致します。
ありがとうございました。

お礼日時：2013/02/04 10:15

No.2 回答者： ap_2 回答日時： 2013/02/04 07:17

手書きでサイズオーバーか・・・がんばりましたね。

。。
あまり複雑になると、メンテナンスも困難になるので、なるべくループして同じ処理を減らすといいです。繰り返す部分を関数化しちゃう手もあります。
記録ベースでも、選択セルとか工夫すれば、Selectionを基準にループできることも多いですよ。

For でも Do でも、同じことできるからお好みで。

'↓よく使うループのパターン
Do While Selection <> ""
　Selection.Offset(1, 0).select　'空じゃなければ次
Loop

r = 1
Do While Cells(r, 1) <> ""
　Cells(r, 1) = r
　r = r + 2 '2行おきに処理
Loop

For r = 1 to 100
　Cells(r, 1) = "1～100行まで処理"
Next

For each sh in Sheets
　sh.Range("A1").Select '全てのシート
　If sh.Name <> "マスター" then
　　sh.Tab.ColorIndex = 1 'マスター以外
　End if
Next

No.1 回答者： ap_2 回答日時： 2013/02/03 12:21

> プロシャーシーが大きすぎと言われてできません。

「プロシージャ」は、Sub ～ End Sub の処理ブロックのことです。何行あるんだろう、ありえないくらいデカイはず・・・
記録は、なるべくムダな操作減らしてシンプルに、ですよ。

再記録大変なので、まずはムダな処理を削除してみてください。
こーいうの↓で埋め尽くされてませんか？
　ActiveWindow.ScrollRow = 数字
画面スクロールなので、その行は削除しちゃって大丈夫です。

それで動かないかな

この回答への補足

回答ありがとうございます
自分で一から作ったため、余分なものが入っていないと思います。。

自分では、作り方が悪いのかと。。
現在、シート１、シート２、シート３、マスターのシートを使っております。
マスターの文字を正として、シート１、シート２　で文字が一致すると
シート３のセルの指定して位置へ　(シート１＋シート２)/1000で値を入力しようと考えました。

この時に、find とif 　then　を使用していますが、
条件不一致の時にエラーが出てしまうため、条件分岐がとてつもなく多くなっています。
loopとか？使えればいいのですが。。この部分が未知なもので。。

アバウトの書き方なので、いまいち説明できていません。
申し訳ありません
お付き合いしていただけたら、幸いです。
よろしくお願いいたします。

補足日時：2013/02/03 22:51