ExcelVBAで複数範囲した色セルと、条件で別セルも同色になるようにしたい

▼Excel2003を利用でSheet1とSheet2を使っての質問です▼

下記に簡単に事例を記載いたします。(※実際にはデータが沢山あります)

★Sheet1にはA1～G3範囲横7列縦3行の表があり、表中にはA1、B1、C1、D1が空白でその次からは1～17までの数字が横列に沿って順次入っています。G3セルが最後の数字の17となっています。
横7列に入っている数字はA1、A2、A3、A4空白のセル以外は列毎にセル背景色が異なり全部で7色入っています。

★次にSheet2に新たにA1～D4範囲内に表を作り、順次セルに数字値を入力し、例えばSheet2のA1セルが1だったら、そのSheet2のA1セル背景色をSheet1の表中の1が入力されているセルと同じ背景色にしたいです。

以上の課題をExcelVBAを使って解決したいのですがご存じの方いらっしゃいましたらVBAでどうプログラミング表現すれば良いか教えていただければ幸いです。

ちなみに私自身はExcelVBAを一度も使ったことがなく初心者です。
恐縮ながらもよろしくお願い申し上げます。

No.4 回答者： van111 回答日時： 2009/08/08 12:54

こんな感じかな？

Sub test()
m = 1
n = 1
Do While Cells(m, n).Value <> ""
Do While Cells(m, n).Value <> ""
h = Cells(m, n)
Cells(m, n).Select
With Worksheets(1).Range("a1:g3")
Set i = .Find(what:=h, LookIn:=xlValues, lookat:=xlWhole)
End With

Worksheets(1).Select
i.Cells.Copy Destination:=Worksheets(2).Cells(m, n)
m = m + 1
Worksheets(2).Select
Loop
n = n + 1
m = 1
Loop
End Sub

No.3 回答者： imogasi 回答日時： 2009/08/07 19:44

>ExcelVBAを一度も使ったことがなく初心者です

このコーナーは課題を書いてコードを回答者に求めるのは規約違反ですよ。コピー貼り付けして、実行して、訳も判らず出来ましたありがとう、は丸投げです。勉強しない段階からこういうものをやりたいと言い出すことがおかしいです。
ーー
Sheet2のA1:D4に数字データがあり、それの全セルを捉えるのはFor　Eachというのを使います。
Sub test01()
Dim cl
For Each cl In Range("A1:D4")
MsgBox cl.Value 'ここに品番の処理を入れる。
Next
End Sub
を実行して、横流れで順次１６セルの値が出ることを確認のこと。
ーー
次にSheet1のA1:G3のセルで、上記コードのcl.Valueの値がどこに有るか探す。それには１つのセルでしか見つからないない場合は
Sub test02()
MsgBox Range("a1:G3").Find(what:=1).Address
End Sub
でwhat:=1).の１を３や５やに変えて捕まえたことを確認のこと。
ーーー
そしてそのSheet1の数字の該当セルの色は
Sub test03()
MsgBox Range("a1:G3").Find(what:=2).Interior.ColorIndex
End Sub
を実行してみて、（What:=のあとの数字を色々変えて見て実行してみて）捕まえられることを納得のこと。
この色コードをSheet2のClセルのセルパターン色に設定すればよい。
ーーー
あと関係するシートが２つあり、前期のコードに出てくるRangeは、どちらのシートの方のRangeを指すか、限定しないといけない。Worksheets("Sheet1").とWorksheets("Sheet2").を前にかぶせて明確にすること。
この辺がヒントだろう。
ーー
もちろん出来上がってみると人により、コードは色々なコードが書けるように思うが。

この回答へのお礼

いろいろご伝授いただきましてありがとうございました。
同時に勉強もさせていただいておりますが、皆様方々のヒントや参考文面を貴重にさせていただきます。
今、いろいろトライしています。

お礼日時：2009/08/07 22:02

No.2 回答者： fujillin 回答日時： 2009/08/07 14:08

＞ちなみに私自身はExcelVBAを一度も使ったことがなく初心者です。

使ったことが無い人がやろうとする内容にしては、少々難しすぎるように思いますが、どこまでご自分でトライしてみたのでしょうか？

お考えの方法とは違うかも知れませんが、Sheet2のマクロに登録して
おくと、数字を入力した時点で背景色に反映されるタイプのマクロです。

#1様のご懸念のように、応用できるのかどうか不明ですが、ご参考まで。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim v, c As Range

'//変更されたセル範囲・値をチェックして、関係なければ処理をしない
If Target.Count > 1 Then Exit Sub
If Intersect(Range("A1:D4"), Target) Is Nothing Then Exit Sub
v = Target.Value
If Not IsNumeric(v) Or v < 1 Or v > 17 Then Exit Sub

'//参照するシートの範囲について順にチェック
'//値が同じだったら、背景色を同じにして終了
For Each c In Worksheets("Sheet1").Range("A1:G3")
　If c.Value = v Then
　　Target.Interior.ColorIndex = c.Interior.ColorIndex
　　Exit For
　End If
Next c
End Sub

この回答への補足

fujillin様

大変ありがとうございました。頂きました参考マクロで完璧に処理が出来、要望が叶いました！！すばらしいです！！

僭越にて恐縮でございますが、同じ要領でもう１点だけ追加で教えていただきたいと思います。
このマクロを実行致しますと新たにSheet2に数値を入力すると無事、セル色の変換が出来ました。
今度はSheet2にはあらかじめ数字が入っており、それを前提としてSheet2にマクロを登録して実行すると同じく数字の入っているセルは自動的に色が変換出来るマクロ処理を教えていただきたいのですが、如何でしょうか？実はSheet2には予め数字が入っているのでした。

こちらのご回答をいただけた時点でこの悩みは100%解決すると思います。感謝いたします。
それではお忙しいところ恐れ入りますがどうぞよろしくお願い申し上げます。

補足日時：2009/08/07 18:19

この回答へのお礼

貴重なヒントを頂きましてありがとうございました。
その後色々とマクロの内容意味、解析も含めて自分でもトライさせていただきまして大変勉強になっております。
いきなりマクロを自在に使えるのは難しいですが少し時間をかけて頑張ってみます。

お礼日時：2009/08/07 22:11

No.1 回答者： n-jun 回答日時： 2009/08/07 13:38

回答ではありませんが。

＞(※実際にはデータが沢山あります)
応用が利くのであればいいですが、未経験であるならば初めからデータ範囲・条件等を
正確に提示された方が宜しいかと思います。

この回答への補足

ご指示いただきましてありがとうございました。
紛らわしい表現記載がありまして大変申し訳ございませんでした。

＞(※実際にはデータが沢山あります)

こちらの内容は無視していただいて結構でございます。
初回に出しました質問事例がクリアできれば解決出来ることだけはわかっております。事例が正確なデータ範囲・条件等提示とご理解いただきまして大丈夫でございます。

要点は複数数値の入っている複数色塗りセル群の中から、別のシートで作ったセル群の中から一致した数字をピックアップして別のシートセルにもそれぞれ同じ色を運んで来たいということでございます。

また、初回質問中の
＞「横7列に入っている数字はA1、A2、A3、A4空白のセル以外．．．」

の表現内容は、

「横7列に入っている数字はA1、B1、C1、D1空白のセル以外．．．」
の誤りでした。訂正いたします。誤解を招き失礼いたしました。

どうぞよろしくお願い申し上げます。

補足日時：2009/08/07 14:18