[[20140603215230]]　『AシートとBシートを比較して、違う箇所に色付けす』（みゆ）　ページの最後に飛ぶ

『AシートとBシートを比較して、違う箇所に色付けする』（みゆ）

マクロ初心者です。マクロがわからず、仕事で躓いてます。どなたか、ご教示下さい。

AシートとBシートのBとC列を基準にして比較をし、違う箇所はBシートに色付けをしたいです。
ランダムにはいっているので、キーとなる列を基準にして、行で比較をしようと考えていますが、うまくマクロができません。

どなたかぜひよろしくお願いします。

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

 > AシートとBシートのBとC列を

 BとC列を連結して比較すればよいのですか？
 比較のイメージが分るようなシートのサンプルがあると回答が得られやすいと
 思いますよ
（kanabun） 2014/06/03(火) 22:12

わかりにくいかもしれませんが、よろしくお願いします。

以下のような表があり、AシートとBシートのBとC列を基準にして数値や文字が変わったらBシートに赤く色を付けたいです。
果物名のセルはBとC列が結合されています。
シートの行数は毎月変動で増減があるため、増減した個所も色がつくとベストなのですが...

≪Aシート≫　　　　　　　　　　≪Bシート≫
　　　B　　　C　　　D　　　　　　　　B　　　C　　　D　　　
8　みかん　　　　　　　　　　8　みかん
9 　愛媛 1　　　　　　　　　　9 愛媛 1
10 　静岡 3　　　　　　　　　10 静岡 4
11 りんご　　　　　　　　　　　11 りんご
・　青森 3　　　　　　　　　　・青森 6
・　長野 2　　　　　　　　　　・長野 2
・　　　　　　　　　　　　　　　・
・ぶどう　山梨 8

（みゆ） 2014/06/04(水) 10:48

以下のマクロを参考にしているのですが、このマクロだと、同じ位置のセルの値に対して
等しくない場合は色がつくのですが、私がやりたいことは、AシートとBシートのBC列をキーにして、
マッチングし、違うところに色を付けたいのですが...
お分かりになる方いらっしゃいましたら、ぜひ教えていただきたいです。

Sub 比較()

 Worksheets.Select 'シート選択
    Cells.Select
    ActiveWorkbook.Names.Add Name:="データ", RefersToR1C1:= _
        "=R1:R1048576" 'シートに名前の定義
    Range("A1").Select 'A1をアクティブセルにする

' 2つのシートの同じ位置のセルの値を比較し、
' 等しくなければそのセルを赤で塗りつぶす。
Dim RETSU_S, RETSU_E, GYOU_S, GYOU_E As Long

RETSU_S = 1 '列をAから（Sはスタート）
RETSU_E = 36 '列をAKまで（Eはエンド）

GYOU_S = 8 '行を8から
GYOU_E = 100 '行を100まで

Dim s1, s2 As Worksheet 'Worksheetsオブジェクト用

Set s1 = Worksheets(1) '比較元シート名
Set s2 = Worksheets(2) '比較先シート名

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.Color = RGB(255, 0, 0)
s2.Cells(gyou, retsu).Interior.Color = RGB(255, 0, 0)
End If
Next
Next
End Sub
（みゆ） 2014/06/04(水) 16:04

 シートのレイアウトがよく分からないのですが、

 > ≪Aシート≫　　　　　　　　　　≪Bシート≫ 
 > 　　　B　　　C　　　D　　　　　　　　B　　　C　　　D　　　 
 > 8　 みかん 　　　　　　　　　　8　 みかん 
 > 9 　愛媛 1　　　　　　　　 　　9 愛媛 1 
 > 10 　 静岡 3　　　　　　　　　10 静岡 4 
 > 11 りんご　　　　　　　　　　　11 りんご 
 > ・ 　 青森 3　　　　　　　　　　・ 青森 6 
 > ・ 　 長野 2　　　　　　　　　　・ 長野 2 
 > ・　　　　　　　　　　　　　　　 ・ 
 > ・ ぶどう 　 山梨 8

 これはすべての行が B,C列結合されている、ということですか？
 もしそうだとすると、
   上の説明図には D列のデータは書き込んでない、ということでしょうか？

 「みかん」
    の一行下に 「愛媛 1」と 「　 静岡 3」がありますが（Aシート）、これらは 
    B列に書き込まれている、ということでしょうか？
    そのばあい、データは 「　 静岡 3」のように 前にスペースがあったり、
    県名と数値のあいだのスペースはデータにより マチマチ（1つだったり 3つのこともある）
    なんでしょうか？
  そもそも 県名 と スペースのあとの数値を列に分けない理由はなんでしょう？

  Aシート 最後のデータ
 > ・ ぶどう 　 山梨 8
  は、これだけまとめてB列の一行に書き込んである、ということでしょうか？
  もしそうだとすると、マッチングするのはむつかしいです。

 仮定の話をつづけますが、
 仮に「愛媛 1」というB列のデータが "県名"＋スペース1個 ＋"1"  のようだったとして、
 Bシートの 「みかん」の下ではなく 別の（たとえば「りんご」の下に）「愛媛 1」があった
 としたら、これは マッチしたということですか？ 
 それとも 種別が違うから、マッチしない、という判断をするのですか？
 それとも、そういうことは原理的にありえない → ので、「　 静岡  3 」というデータが
 あったら、前後のスペースをカットして途中のスペースは1つにした文字列「静岡 3」が
 相手のシートにあれば、マッチしていると判断していいですか？

 AシートとBシートを比較して 「Aにだけしかないもの」「Bにだけしかないもの」を
 抽出できますが、このうち「Bにだけしかないもの」に色付けをすればいいのですか？

 （kanabun） 2014/06/04(水) 23:37

 仮定だらけですが、
 > ≪Aシート≫　　　　　　　　　　≪Bシート≫ 
 > 　　　B　　　C　　　D　　　　　　　　B　　　C　　　D　　　 
 > 8　 みかん 　　　　　　　　　　8　 みかん 
 > 9 　愛媛 1　　　　　　　　 　　9 愛媛 1 
 > 10 　 静岡 3　　　　　　　　　10 静岡 4 
 > 11 りんご　　　　　　　　　　　11 りんご 
 > ・ 　 青森 3　　　　　　　　　　・ 青森 6 
 > ・ 　 長野 2　　　　　　　　　　・ 長野 2 
 > ・　　　　　　　　　　　　　　　 ・ 
 > 20 ぶどう
 > 21　 山梨 8

 のようなシートレイアウトだとして、
 「　 静岡  3」のようなデータは 「静岡 3」に整形して(Trimして)
 比較します。

 Sub CompareA_B()
    'Aシート、 Bシートを変数に
    Dim wsA As Worksheet
    Dim wsB As Worksheet
    Set wsA = ActiveWorkbook.Worksheets("A")
    Set wsB = ActiveWorkbook.Worksheets("B")

    'A, Bシート別に B列のデータをTrimして配列に格納
    Dim rA As Range, rB As Range
    Dim vA, vB
    Set rA = wsA.Range("B8", wsA.Cells(Rows.Count, 2).End(xlUp))
    Set rB = wsB.Range("B8", wsB.Cells(Rows.Count, 2).End(xlUp))
    vA = Application.Trim(rA)
    vB = Application.Trim(rB)

    'A配列の値を辞書に登録
    Dim dicA As Object
    Dim i As Long
    Set dicA = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(vA)
        dicA(vA(i, 1)) = i
    Next

    'BシートのデータがAシート(dicA) になければ  Bシートに色塗り
    For i = 1 To UBound(vB)
        If Not dicA.Exists(vB(i, 1)) Then
            rB.Item(i).Interior.Color = vbRed
        End If
    Next

    MsgBox "比較し Bシートに色塗りしました"
 End Sub

（kanabun） 2014/06/04(水) 23:55

レイアウトがぐちゃぐちゃになってしまい、わかりにくくなってしまいました。
申し訳ありません。

再度説明させていただきます。（両シートとも同じ形式の表です。）

≪Aシート≫≪Bシート≫のB列とC列に比較するキーとなる文字があり、D列からAK列まで数値が
入っています。
（B列に入っているキーが愛媛ならC列はみかん、B列が長野ならC列はぶどうなど決まっています）

≪Aシート≫と≪Bシート≫のB列とC列を比較して、同じ名前のものがあれば、各行を比較し、
行内で違う数値や文字があれば、両シートに色を付けるようにしたいです。（背景色：赤）

各シートは同じ形式ですが、行数が増減するため、上記に記載したマクロでは比較ができませんでした。

以下のシートで
Worksheets(1) '比較元シート名
Worksheets(2) '比較先シート名

以下の列と
RETSU_S = 1 '列をAから
RETSU_E = 36 '列をAKまで

以下の行を
GYOU_S = 8 '行を8から
最終行まで

比較し、キーが同じ名前なら行を比較し、違う数値や文字があれば、両シートに色を付けるようにしたいです。（背景色：赤）

（みゆ） 2014/06/05(木) 12:06

 > （B列に入っているキーが愛媛ならC列はみかん、B列が長野ならC列はぶどうなど決まっています）

 その説明だと、

 まえの説明↓
 > 果物名のセルはBとC列が結合されています。

 > ≪Aシート≫　　　　　　　　　　≪Bシート≫ 
 > 　　　B　　　C　　　D　　　　　　　　B　　　C　　　D　　　 
 > 8　 みかん 　　　　　　　　　　8　 みかん 
 > 9 　愛媛 1　　　　　　　　 　　9 愛媛 1 
 > 10 　 静岡 3　　　　　　　　　10 静岡 4 
 > 11 りんご　　　　　　　　　　 11 りんご 
 > ・ 　 青森 3　　　　　　　　　・ 青森 6 
 > ・ 　 長野 2　　　　　　　　　・ 長野 2 
 > ・　　　　　　　　　　　　　　・ 
 > ・ ぶどう 　 山梨 8

 と整合性がないですよね？
 再度、シートのサンプルをいただけたら 幸いです。
 もし7行目に列見出しがあるのなら それも併せて 説明図に入れていただけると幸いです
（kanabun） 2014/06/05(木) 13:07

うまくサンプルが反映されているか微妙ですが、のせてみます。
わかりにくくて申し訳ありませんが、よろしくお願いします。
果物名と県名が逆になってしまっていました。すみませんでした。
以下が正しいです。

 -----------------------------------
 ≪Aシート≫
 　　　　B　　　C　　　  D　　　E・・・・
  7　　 　　　　果物名　売上　　　　
  8　 　みかん
  9 　　　　　　愛媛　　 1　←BC列結合
 10 　　　　　  静岡 　　3　←BC列結合
 11 　　りんご　　　　　　　　　　 
 12 　 　　　　 青森　　 3　←BC列結合
 13 　 　　　　 長野　　 2　←BC列結合
 14　　　　　　　　　　　　 ←空白行
 15　　　　　　　　　　　　 ←空白行
 ・　　 ぶどう
 ・　　　　　　 山梨　 　8
 ・ 
 ・
 -----------------------------------

 -----------------------------------
 ≪Bシート≫
 　　　　　B　　　C　　　D　　E・・・・
  7　　 　　　　果物名　売上
  8　 　みかん
  9 　　　　　　愛媛　　 1
 10 　　　　　  静岡 　　4
 11 　　りんご　　　　　　　　　　 
 12 　 　　　　 青森　　 6 
 13 　 　　　　 長野　　 2
 14　　 ぶどう
 15　　　　　　 山梨　 　8
 ・
 ・
 -----------------------------------

マクロを実行させて背景色が赤くなる予定の個所は、
≪Aシート≫と≪Bシート≫の、4（静岡）、6（青森）と空白行です。

　　　　　　　　　
（みゆ） 2014/06/05(木) 13:37

 > ≪Aシート≫ 
 > 　　　　　B　　　C　　　D　　　E・・・・ 
 >  7　　 　　　　果物名　売上　　　　
 >  8　 　みかん
 >  9 　　　　　　愛媛　　 1　←BC列結合
 > 10 　　　　　  静岡 　　3　←BC列結合
 > 11 　　りんご　　　　　　　　　　 
 > 12 　 　　　　 青森　　 3　←BC列結合
 > 13 　 　　　　 長野　　 2　←BC列結合
 > 14　　　　　　　　　　　　 ←空白行
 > 15　　　　　　　　　　　　 ←空白行
 > ・　　 ぶどう
 > ・　　　　　　 山梨　 　8
 > ・
 > ・

 「みかん」「りんご」「ぶどう」はB列単独ですか？

 >  9 　　　　　　愛媛　　 1　←BC列結合

 「愛媛」は BC列結合したセルに書いてあるのですか？
  そのあとの 1 は 「売上列」D列に数値として収まっているということですか？

  比較するとき、
    「愛媛」（BC結合列？）と 売上 1 を結合して 「愛媛1」のような文字列とし、
     この文字列が 他シートにあるか、ないかを比較すればいいですか？
  それとも、
     「愛媛」（BC結合列？）の上の行の 「みかん」をさがし、
    この「みかん」と「愛媛」と 売上 1 を結合して 「みかん愛媛1」のような文字列とし、
     この文字列が 他シートにあるか、ないかを比較しないと、県名だけでは識別できないですか？

 （kanabun） 2014/06/05(木) 14:19

 > ≪Aシート≫ 
 > 　　　　　B　　　C　　　D　　　E・・・・ 
 >  7　　 　　　　果物名　売上　　　　
 >  8　 　みかん
 >  9 　　　　　　愛媛　　 1　←BC列結合
 > 10 　　　　　  静岡 　　3　←BC列結合
 > 11 　　りんご　　　　　　　　　　 
 > 12 　 　　　　 青森　　 3　←BC列結合
 > 13 　 　　　　 長野　　 2　←BC列結合
 > 14　　　　　　　　　　　　 ←空白行
 > 15　　　　　　　　　　　　 ←空白行
 > ・　　 ぶどう
 > ・　　　　　　 山梨　 　8
 > ・
 > ・

 おかしいな～～
 「愛媛」が B,C列結合したセル上に書いてあるんだとしたら、
  これやっぱり

 > ≪Aシート≫ 
 > 　　　　　B　　　C　　　D　　　E・・・・ 
 >  7　　 　　　　果物名　売上　　　　
 >  8　 　みかん                  ←BC列結合 なし
 >  9 　　愛媛        　　 1　←BC列結合
 > 10 　　静岡         　　3　←BC列結合
 > 11 　　りんご　　　　　　　　　←BC列結合 なし　 
 > 12 　  青森　        　 3　←BC列結合
 > 13 　  長野　　         2　←BC列結合

 というように 「みかん」と 「愛媛」「静岡」など県名の 表示がみなB列になるはずです。
 「愛媛」「静岡」の表示を右詰めとかにしていれば、 あたかもC列に入力されているようには
 なるけれど、そう表示したいなら、BC列結合して右詰めなんて回りくどいことしなくても、
 セル結合しないで B列には 果物名 C列には 県名 としておいたほうが 懸命 ですよね

（kanabun） 2014/06/05(木) 15:07

（kanabun）さん、親切にありがとうございます。
サンプルがうまくできていないためにお手間を取らせて申し訳ありません。
今度こそ正しいです！！！

≪Aシート≫

 　　　　B　　　C　　　  D　　　E・・・・
  7　　 　果物名　　　　売上　　　　　　　←BC列結合（列見出し）　　　
  8　 　みかん　　　　　　　　　　　　　　←BC列結合
  9 　　　　　　愛媛　　 1　
 10 　　　　　  静岡 　　3　
 11 　　りんご　　　　　　　　　　 　　　 ←BC列結合
 12 　 　　　　 青森　　 3　
 13 　 　　　　 長野　　 2　
 14　　　　　　　　　　　　 　　　　　　　←空白行
 15　　　　　　　　　　　　 　　　　　　　←空白行
 ・　　 ぶどう　　　　　　　　　　　　　　←BC列結合
 ・　　　　　　 山梨　 　8
 ・ 
 ・

 ＞「みかん」「りんご」「ぶどう」はB列単独ですか？
B列に文字がある個所は結合されています。
ただ、データを確認すると、結合を解除しても支障がなさそうでしたので、
解除することも可能です。

＞「愛媛」は BC列結合したセルに書いてあるのですか？
県名は単独です。

＞そのあとの 1 は「売上列」D列に数値として収まっているということですか？
はい、そうです。

＞比較するとき、

    「愛媛」（BC結合列？）と 売上 1 を結合して 「愛媛1」のような文字列とし、
     この文字列が 他シートにあるか、ないかを比較すればいいですか？
  それとも、
     「愛媛」（BC結合列？）の上の行の 「みかん」をさがし、
    この「みかん」と「愛媛」と 売上 1 を結合して 「みかん愛媛1」のような文字列とし、
     この文字列が 他シートにあるか、ないかを比較しないと、県名だけでは識別できないですか？

（kanabun）さんのおっしゃる通りです。
私はB列とC列をキーに比較を考えていたのですが、県名のみで比較しても支障がないと
思い直し、≪Aシート≫≪Bシート≫で同じ名前（県名）のものがあれば、各シートの各行を比較し、
行内で違う数値や文字があれば、両シートに色を付けるようにしたいです。（背景色：赤）
各シートは同じ形式ですが、行数が増減するため、、≪Aシート≫≪Bシート≫のキー同士を
比較する必要があります。

（みゆ） 2014/06/05(木) 15:57

 >  7　　 　果物名　　　　売上　　　　　　　←BC列結合（列見出し）　　　
 >  8　 　 みかん　　　　　　　　　　　　　 ←BC列結合
 >  9 　　　　　　愛媛　　 1　
 > 10 　　　　　  静岡 　　3　
 > 11 　　 りんご　　　　　　　　　　 　　　←BC列結合

 なるほど。こうなら分ります。果物名が書いてある行だけ、B,C列結合しているということ
ですね。
 いちおう、

この「みかん」と「愛媛」と売上 1 を結合して「みかん愛媛1」のような文字列とし、

 の考えで、直前の Sub CompareA_B を改正してみました。

 ・空白セルは色付けしていません。
 ・Bシートにのみある（Aシートにはない）データ行を赤く塗りつぶしています。

 Sub CompareA_B2()
    'Aシート、 Bシートを変数に
    Dim wsA As Worksheet
    Dim wsB As Worksheet
    Set wsA = ActiveWorkbook.Worksheets(1)  '←実際のシートに合わせる
    Set wsB = ActiveWorkbook.Worksheets(2)  '←実際のシートに合わせる

    'wsA, wsB：シート別に B-D列のデータをTrimして配列に格納
    Dim rA As Range, rB As Range
    Dim vA, vB
    Set rA = wsA.Range("B8", wsA.Cells(Rows.Count, 3).End(xlUp).Offset(, -1)).Resize(, 3)
    Set rB = wsB.Range("B8", wsB.Cells(Rows.Count, 3).End(xlUp).Offset(, -1)).Resize(, 3)
    vA = Application.Trim(rA)
    vB = Application.Trim(rB)

    'Aシート側のデータを辞書に登録
    Dim fName As String
    Dim ss As String
    Dim dicA As Object
    Dim i As Long
    Set dicA = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(vA)
        If Len(vA(i, 1)) > 0 Then fName = vA(i, 1) '果物名
        If Len(vA(i, 2)) > 0 Then                   '県名があれば辞書登録
            ss = fName & vA(i, 2) & CStr(vA(i, 3))
            dicA(ss) = i
        End If
    Next

    'BシートのデータがAシート(dicA) になければ  Bシートに色塗り
    rB.Interior.ColorIndex = xlNone
    For i = 1 To UBound(vB)
        If Len(vB(i, 1)) > 0 Then fName = vB(i, 1) '果物名
        If Len(vB(i, 2)) > 0 Then                   '県名があれば辞書登録
            ss = fName & vB(i, 2) & CStr(vB(i, 3))
            If Not dicA.Exists(ss) Then _
                  rB.Item(i, 2).Resize(, 2).Interior.Color = vbRed
        End If
    Next

    MsgBox "比較し Aシートと異なるBシートデータに色塗りしました"
 End Sub

（kanabun） 2014/06/05(木) 16:55

 つづいて、データ範囲内の空白セルは 黄色で塗りつぶす例です。

 Sub CompareA_B3()
    'Aシート、 Bシートを変数に
    Dim wsA As Worksheet
    Dim wsB As Worksheet
    Set wsA = ActiveWorkbook.Worksheets(1)  '←実際のシートに合わせる
    Set wsB = ActiveWorkbook.Worksheets(2)  '←実際のシートに合わせる

    'wsA, wsB：シート別に B-D列のデータをTrimして配列に格納
    Dim rA As Range, rB As Range
    Dim vA, vB
    Set rA = wsA.Range("B8", wsA.Cells(Rows.Count, 3).End(xlUp).Offset(, -1)).Resize(, 3)
    Set rB = wsB.Range("B8", wsB.Cells(Rows.Count, 3).End(xlUp).Offset(, -1)).Resize(, 3)
    vA = Application.Trim(rA)
    vB = Application.Trim(rB)

    'Aシート側のデータを辞書に登録
    Dim fName As String
    Dim ss As String
    Dim dicA As Object
    Dim i As Long
    Set dicA = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(vA)
        If Len(vA(i, 1)) > 0 Then fName = vA(i, 1) '果物名
        If Len(vA(i, 2)) > 0 Then                   '県名があれば辞書登録
            ss = fName & vA(i, 2) & CStr(vA(i, 3))
            dicA(ss) = i
        End If
    Next

    'BシートのデータがAシート(dicA) になければ  Bシートに色塗り
    rB.Interior.ColorIndex = xlNone
    For i = 1 To UBound(vB)
        If Len(vB(i, 1)) > 0 Then
            fName = vB(i, 1) '果物名
        ElseIf Len(vB(i, 2)) > 0 Then                   '県名があれば辞書登録
            ss = fName & vB(i, 2) & CStr(vB(i, 3))
            If Not dicA.Exists(ss) Then _
                  rB.Item(i, 2).Resize(, 2).Interior.Color = vbRed '一致無しの行は赤で塗りつぶし
        Else
            rB.Item(i, 2).Resize(, 2).Interior.Color = vbYellow '空白セルは黄色で塗りつぶし
        End If
    Next

    MsgBox "比較し 空白行と Aシートと異なるBシートデータに色塗りしました"
 End Sub
（kanabun） 2014/06/05(木) 17:03

 最後に、Aシートのほうも同じことをするバージョンです。
 同じコードを B だけでなく Aシートにも適用しただけですが。。。

 Sub CompareA_B4()
    'Aシート、 Bシートを変数に
    Dim wsA As Worksheet
    Dim wsB As Worksheet
    Set wsA = ActiveWorkbook.Worksheets(1)  '←実際のシートに合わせる
    Set wsB = ActiveWorkbook.Worksheets(2)  '←実際のシートに合わせる

    'wsA, wsB：シート別に B-D列のデータをTrimして配列に格納
    Dim rA As Range, rB As Range
    Dim vA, vB
    Set rA = wsA.Range("B8", wsA.Cells(Rows.Count, 3).End(xlUp).Offset(, -1)).Resize(, 3)
    Set rB = wsB.Range("B8", wsB.Cells(Rows.Count, 3).End(xlUp).Offset(, -1)).Resize(, 3)
    vA = Application.Trim(rA)
    vB = Application.Trim(rB)

    'Aシート側のデータを辞書に登録
    Dim fName As String
    Dim ss As String
    Dim dicA As Object, dicB As Object
    Dim i As Long
    Set dicA = CreateObject("Scripting.Dictionary")
    Set dicB = CreateObject("Scripting.Dictionary")

    'AシートのデータをdicAに登録
    For i = 1 To UBound(vA)
        If Len(vA(i, 1)) > 0 Then
            fName = vA(i, 1) '果物名
        ElseIf Len(vA(i, 2)) > 0 Then                   '県名があれば辞書登録
            ss = fName & vA(i, 2) & CStr(vA(i, 3))
            dicA(ss) = i
        Else
            ss = "A" & Format$(i, "0000")
            dicA(ss) = -i '空白セル
        End If
    Next
    'BシートのデータをdicBに登録
    For i = 1 To UBound(vB)
        If Len(vB(i, 1)) > 0 Then
            fName = vB(i, 1) '果物名
        ElseIf Len(vB(i, 2)) > 0 Then                   '県名があれば辞書登録
            ss = fName & vB(i, 2) & CStr(vB(i, 3))
            dicB(ss) = i
        Else
            ss = "B" & Format$(i, "0000")
            dicB(ss) = -i  '空白セル
        End If
    Next

    'BシートのデータがAシート(dicA) になければ  Bシートに色塗り
    rB.Interior.ColorIndex = xlNone
    Dim ky
    For Each ky In dicB.Keys()
        If Not dicA.Exists(ky) Then
            i = dicB(ky)
            If i > 0 Then
                rB.Item(i, 2).Resize(, 2).Interior.Color = vbRed '一致無しの行は赤で塗りつぶし
            Else
                rB.Item(-i, 2).Resize(, 2).Interior.Color = vbYellow '空白セルの行は黄色で塗りつぶし
            End If
        End If
    Next

    'AシートのデータがBシート(dicB) になければ  Aシートに色塗り
    rA.Interior.ColorIndex = xlNone
    For Each ky In dicA.Keys()
        If Not dicB.Exists(ky) Then
            i = dicA(ky)
            If i > 0 Then
                rA.Item(i, 2).Resize(, 2).Interior.Color = vbRed '一致無しの行は赤で塗りつぶし
            Else
                rA.Item(-i, 2).Resize(, 2).Interior.Color = vbYellow '空白セルの行は黄色で塗りつぶし
            End If
        End If
    Next

    MsgBox "両シートを比較し 他方に無いデータ行を色塗りしました"
 End Sub
 （この3つのサンプルがあれば、どれかが利用できるでしょう ^^）

（kanabun） 2014/06/05(木) 17:31

（kanabun）さん素晴らしいです！！
ありがとうございます！！
最後のマクロが理想的です！！

列の範囲を変えたい場合は以下を修正するのでしょうか？
お恥ずかしいのですが、どの部分かわからず...
よろしくお願いします。

'wsA, wsB：シート別に B-D列のデータをTrimして配列に格納

    Dim rA As Range, rB As Range
    Dim vA, vB
    Set rA = wsA.Range("B8", wsA.Cells(Rows.Count, 3).End(xlUp).Offset(, -1)).Resize(, 3)
    Set rB = wsB.Range("B8", wsB.Cells(Rows.Count, 3).End(xlUp).Offset(, -1)).Resize(, 3)
    vA = Application.Trim(rA)
    vB = Application.Trim(rB)

（みゆ） 2014/06/05(木) 18:10

 > 列の範囲を変えたい場合は

 どのように変えたいのですか？
 たとえば、
 > Set rA = wsA.Range("B8", wsA.Cells(Rows.Count, 3).End(xlUp).Offset(, -1)).Resize(, 3)
 のばあい、
  範囲の先頭セルは [B8] セル固定としています。

wsA.Cells(Rows.Count, 3).End(xlUp).Offset(, -1))

 というのは、C列のデータ最終セルを求め、その左隣のB列セル、これをB列最終セルとする、ということ。
 その([B8],[B最終行]) という範囲を 列方向に3列分に拡張した(Resize)範囲を rA としてSetする、
 という意味ですけど？
 参考になりますか？ 
（kanabun） 2014/06/05(木) 18:40

奥が深いですね…

列の変更はB列からAK列までを範囲にしたいです。
行は8行目からで大丈夫です。

ちなみに≪Aシート≫のC９に愛媛と入っていて≪Bシート≫のC９は空白の場合、どちらのセルも
赤い背景色になるような設定は、作成していただいたマクロに入っていますか？
（みゆ） 2014/06/05(木) 19:08

 > 列の変更はB列からAK列までを範囲にしたいです。

 比較データとして列範囲を変更のときは
 >    Set rA = wsA.Range("B8", wsA.Cells(Rows.Count, 3).End(xlUp).Offset(, -1)).Resize(, 3)
 >    Set rB = wsB.Range("B8", wsB.Cells(Rows.Count, 3).End(xlUp).Offset(, -1)).Resize(, 3)

 の部分の Resizeを必要な列数に代えますが、
 塗りつぶしの列範囲なら Aシート、Bシート2か所ある

 >            If i > 0 Then
 >                rB.Item(i, 2).Resize(, 2).Interior.Color = vbRed '一致無しの行は赤で塗りつぶし
 >            Else
 >                rB.Item(-i, 2).Resize(, 2).Interior.Color = vbYellow '空白セルの行は黄色で塗りつぶし
 >            End If

 のResize(,n) の n を必要な列数に替えてください。

（kanabun） 2014/06/05(木) 20:20

ご丁寧にありがとうございます。わかり易くて素人の私にはとてもありがたいです。明日会社で試してみます。
（みゆ） 2014/06/05(木) 22:00

 ひとりごとですけど...
 （みゆ）さんはすごいですね。
    一度に４つのスレッドを同時進行してるんですか？

 （すごい というか 尋常じゃないです）

 （kanabun） 2014/06/05(木) 23:03

 切羽詰っていらっしゃるんでしょうねぇ。
 有力な先生方のアドバイスとその胆力でどうにか乗り越えられる事を祈っています。
（Jera） 2014/06/06(金) 01:50

コメント返信：

[ 一覧(最新更新順) ]

[[20140603215230]] 『AシートとBシートを比較して、違う箇所に色付けす』（みゆ） ページの最後に飛ぶ

[[20140603215230]]　『AシートとBシートを比較して、違う箇所に色付けす』（みゆ）　ページの最後に飛ぶ