dポイントプレゼントキャンペーン実施中!

シートを突合するマクロを色々なコードを見て、
使えるようにしていたのですが、

条件と突合先のデータが色々な場所にあるので、
突合作業が上手く行かないので、相談させてください。

シート同士を突合して、
不一致だった場合、色を塗って
不一致箇所にコメントで大元のデータをコメントに表示させるという事を
行いたいのですが、データが多岐に渡り、
さらに、アクセスから抽出したデータのため、
突合する番号が重複して、存在しているので
Find nextで動かすか
配列に格納させて、突合させる方法もあると開発者からアドバイスを頂いたのですが、

その開発者の方が退職してるため、
色々調べて、ほかの人のコードを参考にしながら
やってみたのですが、上手くいかないので、
行き詰まってしまったので、どなたか、
良い方法があれば教えて頂けませんか?


下記に途中ですが、マクロのコードと
概要と添付にて図を表示します。
お手数ですが、宜しくお願い致します

Sub 突合テスト()
Dim A As Long, B As Long
Dim C As Worksheet, D As Worksheet
Set C = Worksheets("突合先")
Set D = Worksheets("データ")
A = Range("C65536").End(xlUp).Row
B = Range("IV" & A).End(xlToLeft).Column
With C
For A = 3 To A
For B = 3 To B
If .Cells(A, B) <> D.Cells(A, B) Then
.Cells(A, B).Interior.ColorIndex = 38 '←色をぬる
Else
.Cells(A, B).Interior.ColorIndex = 0
End If
Next B
Next A
End With
End Sub

前任者の方が参考にとのことで、
ネットに記述されていたコードを基に変えていけばいいと
言われて残されたコードです。
条件が複雑のため、改造しようと色々と考えましたが
上手く行かないので、アドバイス方お手数ですがよろしくお願いいたします。


--------------------------------------------------------------------------
☆概要構成☆


突合先シート(データと違ってた場合,色を塗って違った値をコメントに入れる)

   C列 D列 E列 F列 G列
0119998888 AA1  BB1 CC1 DD1
0119998889 AA2 BB2 CC2 DD2
0119998890 AA3 BB3 CC3 DD3
0119998891 AA4 BB4 CC4 DD4
0119998892 AA5 BB5 CC5 DD5

→データは3行目から始まって都度、行の数は変動する。
  C列 D列 E列 F列 G列にデータが記述



--------------------------------------------------------------------------
比較するデータシート(アクセスで抽出したデータをエクセルにしているもの
              フィールド分けされており、基準となる番号がD列に重複して存在
              列は動かないが、行の数は変動する)



   D列    M列 AD列
0119998888      BB1  AA2
0119998889      BB2 AA3
0119998890  ~  BB3 AA4
0119998891     BB4 AA5
0119998892     BB5 AA6

      D列       N列 X列
0119998888      CC1  DD1
0119998889      CC2 DD2
0119998890  ~  CC3 DD3
0119998891     CC4 DD4
0119998892     CC5 DD5


→元々はアクセスからデータを抽出しているため、広範囲までII列までデータが存在
 行も変動するが1000行以上ある


D列に基準となる番号が突合先のシートC列の番号と同じものがあるが
確認するデータのカテゴリの関係上、
重複して存在している。

----------------------------------------------------------------------------

最終的にやること


突合して、
突合先のシートのD列とデータシートのAD列が一致してなかったら、
突号先のシートのD列のセルに
一致してない箇所のセルをピンク色に塗る。
データシートのセル値を突合先セルのコメントに入れる。


突合先のシートのE列とデータシートのM列が一致してなかったら、
突号先のシートのE列のセルに
一致してない箇所のセルをピンク色に塗る。
データシートのセル値を突合先セルのコメントに入れる。


突合して、
突合先のシートのF列とデータシートのN列が一致してなかったら、
突号先のシートのF列のセルに
一致してない箇所のセルをピンク色に塗る。
データシートのセル値を突合先セルのコメントに入れる。


突合先のシートのG列とデータシートのX列が一致してなかったら、
突号先のシートのG列のセルに
一致してない箇所のセルをピンク色に塗る。
データシートのセル値を突合先セルのコメントに入れる。

「2つのシート突合の相違時色塗りとコメント」の質問画像

質問者からの補足コメント

  • うーん・・・

    コードありがとうございます!!
    色々確認して、確認する予定ですが、
    コードを実行すると、下記の場所にエラー出たのは、
    データ先のシートの条件がまずかったのでしょうか?

    「2つのシート突合の相違時色塗りとコメント」の補足画像1
    No.1の回答に寄せられた補足コメントです。 補足日時:2015/10/21 22:27
  • エラー修正してもらって、動きを確認できました。
    コードを再度、見直したのですが、
    突合先とデータが同じ列で動くコードだったので、
    一度、突合の番号を別で格納してから、動かしてみます

      補足日時:2015/10/23 19:33
  • 返答遅れて申し訳ありません。
    無事、動きました ありがとうございます

      補足日時:2015/10/28 20:59

A 回答 (4件)

シート[突合先]のC列の最終行【A】と3行の最終列【B】を取得


A3セルから最終行:最終列を比較範囲
相違があった場合にシート[突合先]の該当セルを塗りつぶして、コメントを挿入するマクロコードです。
コメントには、シート[データ]の値が入ります。


Sub 突合テスト2()

Dim A As Long, B As Long
Dim C As Worksheet, D As Worksheet
Dim i As Long, k As Long
Set C = Worksheets("突合先")
Set D = Worksheets("データ")
C.Activate

A = Range("C65536").End(xlUp).Row
B = Range("iv3").End(xlToLeft).Column
Cells.ClearComments
'すべてのコメントを削除してから比較・コメント挿入という流れです。

With C
For k = 3 To A
For i = 3 To B

If .Cells(k, i) <> D.Cells(k, i) Then
.Cells(k, i).Interior.ColorIndex = 38 '←色をぬる
.Cells(k, i).AddComment
.Cells(k, i).Comment.Visible = True
.Cells(k, i).Comment.Text Text:=D.Cells(k, i).Value

Else
.Cells(k, i).Interior.ColorIndex = xlNone
End If
Next i
Next k
End With

End Sub


---------------------------------------------------

ご質問の記事に掲載されていたコード Sub突合テストを部分的に修正しただけです。

修正した箇所
B = Range("IV" & A).End(xlToLeft).Column
最終列を求めるコードですが、Rangeの指定が間違っています。

正しくは
B = Range("iv3").End(xlToLeft).Column
三行目の最終列を求めましたが、一行目にする場合はRange("iv1")に書き直してください。


For A = 3 To A
For文にAが二回出てきますが、これでは処理ができません。

For 変数 初期値 to 最終値
という書き方をします。

A と B は最終値として使いますので、別の変数を宣言して使います。
i と k を使いました。

For k = 3 To A
For i = 3 To B
この回答への補足あり
    • good
    • 0

相違があった時にデータシートのセルの値をコメントとして表示させる処理なんですが、コメントには[数値]を入れられないみたいなんです。

相違セルの値が数値だとエラーになります。
対策は文字列型の変数を宣言して、データシートの値を文字列に変換する必要があります。
Dim Str As String

If .Cells(k, i) <> D.Cells(k, i) Then
Str =D.Cells(k, i).Value
.Cells(k, i).Comment.Text Text:= Str
    • good
    • 0

原因が分かりました。


[データ]のセルが空白で、[突合先]の同一セルに値がある場合、

.Cells(k, i).Interior.ColorIndex = 38 '←色をぬる
.Cells(k, i).AddComment
.Cells(k, i).Comment.Visible = True

セルに色を塗って【コメント枠】を表示することはできますが、
.Cells(k, i).Comment.Text Text:=D.Cells(k, i).Value
D.Cells(k, i).Valueが存在しないので、コメントにテキストが入りません。

エラーを回避するには、
If .Cells(k, i) <> D.Cells(k, i) Then


If .Cells(k, i) <> D.Cells(k, i) And _
D.Cells(k, i) <> "" Then
に書き換えてください。
    • good
    • 1
この回答へのお礼

返答遅れて申し訳ありません。
エラーに関してアドバイスありがとうございます。
コードを検証させて頂きます!!!

お礼日時:2015/10/22 20:30

'.Cells(k, i).Comment.Text Text:=D.Cells(k, i).Value


このコードの先頭にシングルクォーテーションを打ってやり直してみてください。

その行でエラーになるということは、その前のコード(セルに色を塗る、コメントを挿入)は出来ているはずです。
シート[突合先]の色が塗られたセルがF54だったとしたら、シート[データ]のF54を調べてみてください。シート[データ]に値がないのかもしれません。


他の調べ方として、そのデータブックは一旦閉じて、仮のブックを新規作成してください。
そして、そのブックのシート名を[突合先]に変更します。

[突合先]のB3:F100ぐらいの範囲を選択して同じ値(数字でも文字列でも可)を入力してください。Ctrl+Enterで選択範囲に同じ値が入ります。
そしてそのシートを同一ブックに複製し、シート名を[データ]にします。

[突合先]の任意のセルに、入力済みの値とは異なる値を入力します。動作確認用なので1つのセルだけ変更すれば充分です。

この状態で、マクロを実行してください。

値を変更したセルが塗りつぶされて、最初に入力した値がコメントとして挿入されるか調べてみてください。
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!