• 締切済み

2つのシートの比較で更新分だけを色付けしたい

表を管理していて、前月のある日に保存した内容と 翌月のある日に保存した内容を比較して 差分を取りたいのです。 例えば、表を更新した時に行が追加されたりして レコードはひとつ追加になっているけれど 他の内容は変わってないとします。 しかし、同じ位置の同じセルの値を比較だと 追加した行以降全てのセルに色が付いてしまいます。 これを、追加された行(レコード)だけを 色付けるようにしたいのです。 >If s1.Cells(gyou, retsu).Value <> s2.Cells(gyou, retsu).Value Then > > '同じ位置のセルの値が等しくなければ、そのセルを赤で塗りつぶす。 この部分に手を加えればいいのかと思うのですが、解りません。 どのようにすればいいのか教えていただけないでしょうか? お願いいたします。 Sub シート比較()  Dim RETSU_S, RETSU_E, GYOU_S, GYOU_E As Long RETSU_S = 1 RETSU_E = 10 GYOU_S = 2 GYOU_E = 101   Dim s1, s2 As Worksheet  Set s1 = Worksheets("Sheet1")  Set s2 = Worksheets("Sheet2") Dim retsu, gyou As Long 'この変数で列と行を指定する For gyou = GYOU_S To GYOU_E For retsu = RETSU_S To RETSU_E If s1.Cells(gyou, retsu).Value <> s2.Cells(gyou, retsu).Value Then '同じ位置のセルの値が等しくなければ、そのセルを赤で塗りつぶす。 s1.Cells(gyou, retsu).Interior.ColorIndex = 3 s2.Cells(gyou, retsu).Interior.ColorIndex = 3 End If Next Next End Sub

みんなの回答

  • tom04
  • ベストアンサー率49% (2537/5117)
回答No.3

No.1です。 補足の >このSheet1とSheet2を比較したとき >Sheet2のA1に"か"、A3に"き"、A5に"く"に色がつくようにできるとありがたいのです すなわちSheet2のA列データがSheet1のA列にない場合にそのセルの色を付けたい!というコトですね? そうであればごくごく簡単に・・・ Sub シート比較3() Dim i As Long, c As Range, wS As Worksheet Set wS = Worksheets("Sheet1") With Worksheets("Sheet2") .Range("B:B").Interior.ColorIndex = xlNone For i = 1 To .Cells(Rows.Count, "A").End(xlUp).Row Set c = wS.Range("A:A").Find(what:=.Cells(i, "A"), LookIn:=xlValues, lookat:=xlWhole) If c Is Nothing Then .Cells(i, "A").Interior.ColorIndex = 3 End If Next i End With End Sub としてみてはどうでしょうか?m(_ _)m

umezou471
質問者

お礼

さっそく、ありがとうございます。 後で、試してみます! >単純に ってことは、こっちのコードの方が簡単というか、オーソドックスってことなんですかね? 説明が下手で遠回りさせてしまいました。 すみませんでした! でも、ちょっと違う色々なパターンを見れると勉強になるので、ありがたいです。

回答No.2

Option Explicit Dim s1 As Worksheet Dim s2 As Worksheet Dim retsu, gyou As Long 'この変数で列と行を指定する Dim gyou2 As Long Dim RETSU_S, RETSU_E, GYOU_S, GYOU_E As Long Dim GYOU_E2 As Long Sub シート比較() GYOU_S = 2 'GYOU_E = 101 RETSU_S = 1 RETSU_E = 10 Set s1 = Worksheets("Sheet1") Set s2 = Worksheets("Sheet2") s1.UsedRange.Interior.Color = vbWhite s2.UsedRange.Interior.Color = vbWhite GYOU_E = s1.Cells(Rows.Count, "A").End(xlUp).Row GYOU_E2 = s2.Cells(Rows.Count, "A").End(xlUp).Row For gyou = GYOU_S To GYOU_E For gyou2 = GYOU_S To GYOU_E2 If s1.Cells(gyou, "A").Value = s2.Cells(gyou2, "A").Value Then '行が一致 Call HowMuch GYOU_S = gyou2 + 1 Exit For Else If s1.Cells(gyou, "A").Value < s2.Cells(gyou2, "A").Value Then '左だけ s1.Range(s1.Cells(gyou, RETSU_S), s1.Cells(gyou, RETSU_E)).Interior.Color = vbRed Exit For Else '右だけ s2.Range(s2.Cells(gyou2, RETSU_S), s2.Cells(gyou2, RETSU_E)).Interior.Color = vbRed End If End If Next If (gyou2 > GYOU_E2) Then s1.Range(s1.Cells(gyou, RETSU_S), s1.Cells(GYOU_E, RETSU_E)).Interior.Color = vbRed Exit For End If Next If Not (gyou2 > GYOU_E2) Then s2.Range(s2.Cells(gyou2, RETSU_S), s2.Cells(GYOU_E2, RETSU_E)).Interior.Color = vbRed End If MsgBox ("Done de Done !!") End Sub Private Function HowMuch() For retsu = RETSU_S To RETSU_E If s1.Cells(gyou, retsu).Value <> s2.Cells(gyou2, retsu).Value Then '同じ位置のセルの値が等しくなければ、そのセルを黄色で塗りつぶす。 s1.Cells(gyou, retsu).Interior.Color = vbYellow s2.Cells(gyou2, retsu).Interior.Color = vbYellow End If Next End Function

umezou471
質問者

お礼

ありがとうございます。 PCが使えない為、まだ試していませんが コードをよく読んで理解したいと思います。 本来、実行してからお礼申し上げるべきですが 取り急ぎ、お礼させて頂きます。

  • tom04
  • ベストアンサー率49% (2537/5117)
回答No.1

こんばんは! すでに色がついているセルの色は消す必要はないのですね? >2つのシートの比較で更新分だけを・・・ というコトですので、考え方としては Sheet1の最終行とSheet2の最終行の比較で行数の少ないSheetの最終行+1行目~行数の多いSheetの最終行までループしてみてはどうでしょうか? 一例です。 Sub シート比較2() Dim i As Long Dim j As Long Dim Gyou1 As Long Dim Gyou2 As Long Dim minGyou As Long Dim maxGyou As Long Dim s1 As Worksheet Dim s2 As Worksheet Set s1 = Worksheets("Sheet1") Set s2 = Worksheets("Sheet2") Gyou1 = s1.Cells(Rows.Count, "A").End(xlUp).Row Gyou2 = s2.Cells(Rows.Count, "A").End(xlUp).Row minGyou = WorksheetFunction.Min(Gyou1, Gyou2) maxGyou = WorksheetFunction.Max(Gyou1, Gyou2) If minGyou <> maxGyou Then For i = minGyou + 1 To maxGyou For j = 1 To 10 If s1.Cells(i, j) <> s2.Cells(i, j) Then s1.Cells(i, j).Interior.ColorIndex = 3 s2.Cells(i, j).Interior.ColorIndex = 3 End If Next j Next i End If End Sub ※ 両SheetともA列で最終行を取得していますので、A列には何らかのデータが必ず入るという前提です。 ※ 変数の宣言で >Dim RETSU_S, RETSU_E, GYOU_S, GYOU_E As Long のようにしてしまうと、 RETSU_S RETSU_E GYOU_S の3つは何も宣言していないので「Variant」型になってしまいます。 大勢には影響ないのですが、厳密にいえば一つ一つちゃんと宣言してやる習慣をつけた方が良いと思います。 こんな感じではどうでしょうか?m(_ _)m

umezou471
質問者

お礼

ありがとうございます。 今、PCが使えない(家族と共用なので)ので、マクロを実行していないのですが、よく読んで理解します。 試してから、お礼申し上げたいのですが・・・取り急ぎお礼申し上げます。

umezou471
質問者

補足

マクロの動作確認しました。 ちょっと、私がイメージしていたのとは違っていて‥ でも、どうアレンジしたらいいのか解らずです。 イメージでは、 Sheet1の、A1に"あ"、A2に"い"、A3に"う" と入力した表があって それをコピーした表Sheet2には、新しい情報を加えるので A1に"か"、A2に"あ"、A3に"き"、A4に"い"、A5に"く"、A6に"う" となります。 このSheet1とSheet2を比較したとき Sheet2のA1に"か"、A3に"き"、A5に"く"に色がつくようにできるとありがたいのです。 もう少し、お付き合い頂いて教えて下さると嬉しいです。 お聞きするばかりで、本当に申し訳ありません。 よろしくお願い致します。