都道府県穴埋めゲーム

2つのシートのデータを差分チェックするツールを作成したのですが、上手くいかない箇所があり
ご教授いただきたく思います。

◆作成しているツール◆
「①データ」シートと「②データ」シートの「番号」をキー(★)にして同じ行の項目が
一致しているか確認するツールです。
 「①データ」シート        「②データ」シート
★I3から最終行の番号   ⇒   ★1行目「番号」の文字列・2行目から最終行の番号
 D3から最終行の文字   ⇒    1行目「処理」の文字列・2行目から最終行の文字
 O3から最終行の数字   ⇒    1行目「数量」の文字列・2行目から最終行の数字
 U3から最終行の数字   ⇒    1行目「価額」の文字列・2行目から最終行の数字

 ※「②データ」シートは、列が変わることがあるので指定せずに検索を行っています。
 ※「一致」の場合は、メッセージ「一致」
  「不一致」の場合は、メッセージ「不一致」と不一致箇所に色がつくようにしています。

◆問題点◆
「①データ」シートには、差分チェックに入れたくない行のデータもあるのですが、
現状は「①データ」シートに番号があって「②データ」シートに番号がないと認識され「不一致」のメッセージと色がついてしまいます。
差分チェックに入れたくない行は、A~Dすべてのセルが空白の行になるので、A3:D3から最終行
まででA~Dすべてのセルが空白の行の場合は「一致」で色がつかないようにしたいです。
いろいろ試したのですが、思うようにできません。ご教授いただけると有難いです。
宜しくお願いします。

Sub 差分チェック()

Dim 一致 As Boolean
Dim 不一致 As Boolean
Dim srcRow As Long '元行
Dim srcend As Long '元終
Dim dstRow As Long '先行
Dim dstend As Long '先終
Dim Color As Long '色
Dim myS As Range, myV As Range, myN As Range, myK As Range
Dim Sh1 As Worksheet, Sh6 As Worksheet
Set Sh1 = Worksheets("①データ")
Set Sh6 = Worksheets("②データ")
Set myS = Sh6.Rows(1).Find(what:="処理", LookIn:=xlValues, lookat:=xlWhole) '←「処理」列を取得
Set myV = Sh6.Rows(1).Find(what:="数量", LookIn:=xlValues, lookat:=xlWhole) '←「数量」列を取得
Set myK = Sh6.Rows(1).Find(what:="価額", LookIn:=xlValues, lookat:=xlWhole) '←「価額」列を取得
Set myN = Sh6.Rows(1).Find(what:="番号", LookIn:=xlValues, lookat:=xlWhole) '←「番号」列を取得

Color = RGB(255, 0, 0)
srcend = Sh6.Cells(Rows.Count, myN.Column).End(xlUp).Row
dstend = Sh1.Cells(Rows.Count, 5).End(xlUp).Row
For srcRow = 2 To srcend
一致 = False
For dstRow = 3 To dstend

If Sh6.Cells(srcRow, myN.Column).Value = Sh1.Cells(dstRow, 9).Value Then

If Sh6.Cells(srcRow, myS.Column).Value <> Sh1.Cells(dstRow, 4).Value Then
Sh6.Cells(srcRow, myS.Column).Interior.Color = Color
Sh1.Cells(dstRow, 1).Interior.Color = Color
Sh1.Cells(dstRow, 4).Interior.Color = Color
不一致 = True
End If

If Sh6.Cells(srcRow, myV.Column).Value <> Sh1.Cells(dstRow, 15).Value Then
Sh6.Cells(srcRow, myV.Column).Interior.Color = Color
Sh1.Cells(dstRow, 2).Interior.Color = Color
Sh1.Cells(dstRow, 15).Interior.Color = Color
不一致 = True
End If

If Sh6.Cells(srcRow, myK.Column).Value <> Sh1.Cells(dstRow, 21).Value Then
Sh6.Cells(srcRow, myK.Column).Interior.Color = Color
Sh1.Cells(dstRow, 3).Interior.Color = Color
Sh1.Cells(dstRow, 21).Interior.Color = Color
不一致 = True
End If

一致 = True
Exit For
End If
Next

If 一致 = False Then
Sh6.Cells(srcRow, myN.Column).Interior.Color = Color
不一致 = True
End If
Next
For dstRow = 3 To dstend
一致 = False
For srcRow = 2 To srcend
If Sh6.Cells(srcRow, myN.Column).Value = Sh1.Cells(dstRow, 9).Value Then
一致 = True

Exit For
End If
Next
If 一致 = False Then
Sh1.Cells(dstRow, 9).Interior.Color = Color
不一致 = True

End If
Next
If 不一致 Then
MsgBox ("不一致 ")
Else
MsgBox ("一致 ")
End If

Sh1.Activate
Range("A1").Select

End Sub

A 回答 (4件)

「①データ」シートのA~Dすべてのセルが空白の行の場合は、比較自体を行わないようにしました。


--------------------------------------------
Option Explicit

Sub 差分チェック()

Dim 一致 As Boolean
Dim 不一致 As Boolean
Dim srcRow As Long '元行
Dim srcend As Long '元終
Dim dstRow As Long '先行
Dim dstend As Long '先終
Dim Color As Long '色
Dim myS As Range, myV As Range, myN As Range, myK As Range
Dim Sh1 As Worksheet, Sh6 As Worksheet
Set Sh1 = Worksheets("①データ")
Set Sh6 = Worksheets("②データ")
Set myS = Sh6.Rows(1).Find(what:="処理", LookIn:=xlValues, lookat:=xlWhole) '←「処理」列を取得
Set myV = Sh6.Rows(1).Find(what:="数量", LookIn:=xlValues, lookat:=xlWhole) '←「数量」列を取得
Set myK = Sh6.Rows(1).Find(what:="価額", LookIn:=xlValues, lookat:=xlWhole) '←「価額」列を取得
Set myN = Sh6.Rows(1).Find(what:="番号", LookIn:=xlValues, lookat:=xlWhole) '←「番号」列を取得

Color = RGB(255, 0, 0)
srcend = Sh6.Cells(Rows.Count, myN.Column).End(xlUp).row
dstend = Sh1.Cells(Rows.Count, 5).End(xlUp).row
For srcRow = 2 To srcend
一致 = False
For dstRow = 3 To dstend
If CheckSkip(Sh1, dstRow) = True Then GoTo SKIP1 '追加
If Sh6.Cells(srcRow, myN.Column).Value = Sh1.Cells(dstRow, 9).Value Then

If Sh6.Cells(srcRow, myS.Column).Value <> Sh1.Cells(dstRow, 4).Value Then
Sh6.Cells(srcRow, myS.Column).Interior.Color = Color
Sh1.Cells(dstRow, 1).Interior.Color = Color
Sh1.Cells(dstRow, 4).Interior.Color = Color
不一致 = True
End If

If Sh6.Cells(srcRow, myV.Column).Value <> Sh1.Cells(dstRow, 15).Value Then
Sh6.Cells(srcRow, myV.Column).Interior.Color = Color
Sh1.Cells(dstRow, 2).Interior.Color = Color
Sh1.Cells(dstRow, 15).Interior.Color = Color
不一致 = True
End If

If Sh6.Cells(srcRow, myK.Column).Value <> Sh1.Cells(dstRow, 21).Value Then
Sh6.Cells(srcRow, myK.Column).Interior.Color = Color
Sh1.Cells(dstRow, 3).Interior.Color = Color
Sh1.Cells(dstRow, 21).Interior.Color = Color
不一致 = True
End If

一致 = True
Exit For
End If
SKIP1: '追加
Next

If 一致 = False Then
Sh6.Cells(srcRow, myN.Column).Interior.Color = Color
不一致 = True
End If
Next
For dstRow = 3 To dstend
If CheckSkip(Sh1, dstRow) = True Then GoTo SKIP2 '追加
一致 = False
For srcRow = 2 To srcend
If Sh6.Cells(srcRow, myN.Column).Value = Sh1.Cells(dstRow, 9).Value Then
一致 = True

Exit For
End If
Next
If 一致 = False Then
Sh1.Cells(dstRow, 9).Interior.Color = Color
不一致 = True

End If
SKIP2: '追加
Next
If 不一致 Then
MsgBox ("不一致 ")
Else
MsgBox ("一致 ")
End If

Sh1.Activate
Range("A1").Select

End Sub


'チェックをスキップするか判定する
Private Function CheckSkip(ByVal sh As Worksheet, ByVal row As Long) As Boolean
CheckSkip = False
If sh.Cells(row, 1).Value <> "" Then Exit Function
If sh.Cells(row, 2).Value <> "" Then Exit Function
If sh.Cells(row, 3).Value <> "" Then Exit Function
If sh.Cells(row, 4).Value <> "" Then Exit Function
CheckSkip = True
End Function
---------------------------------------------------
1)Private Function CheckSkip()を追加します。・・・指定された行がスキップ対象の場合、trueを返します。
2)Sub 差分チェック() へ「'追加」のコメントがついている行を追加します。(4行追加します)
以上で完了です。
    • good
    • 0
この回答へのお礼

思う通りの処理ができるようになりました。
解説も含めありがとうございました。
勉強になりました。

お礼日時:2017/01/17 10:04

>質問3は、おっしゃる通りで①のデータシートの最終行をI列(番号)に変更した方が良いと思いました。


dstend = Sh1.Cells(Rows.Count, 5).End(xlUp).Row
この行を
dstend = Sh1.Cells(Rows.Count, 9).End(xlUp).Row
に変えてください。(5を9に変更)
    • good
    • 0
この回答へのお礼

変更できました。
ありがとうございます。

お礼日時:2017/01/17 10:07

補足要求の追加です。


質問3)
①データシートの最終行はE列の最終行としてますが、
②データシートの最終行は”番号”の列の最終行を採用しています。
①データシートの最終行はI列(番号)の最終行でなくて良いのでしょうか。

質問4)
①データシートの番号は重複無しと考えて良いですか。
    • good
    • 0
この回答へのお礼

質問ありがとうございます。
質問3は、おっしゃる通りで①のデータシートの最終行をI列(番号)に変更した方が良いと思いました。
質問4は①データシート内の番号の重複は無しです。(②データシート内の番号の重複も無しです。)
宜しくお願い致します。

お礼日時:2017/01/16 16:47

補足要求です。


質問1)
「①データ」シートには、差分チェックに入れたくない行のデータもあるのですが、
現状は「①データ」シートに番号があって「②データ」シートに番号がないと認識され「不一致」のメッセージと色がついてしまいます。
上記のケースが発生した場合に限り、
「①データ」シートのA~Dすべてのセルが空白の行の場合は「一致」で色がつかないようにするのですか?

それとも
質問2)
「①データ」シートのA~Dすべてのセルが空白の行の場合は、
そもそも、比較自体(処理、数量、価額の比較を含む)を行わないようにしたいのですか?
    • good
    • 0
この回答へのお礼

返信ありがとうございます。
質問1がしたいのではなく、質問2をしたいと思っております。
よろしくお願い致します。

お礼日時:2017/01/16 16:39

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