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
No.3ベストアンサー
- 回答日時:
「①データ」シートの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行追加します)
以上で完了です。
No.4
- 回答日時:
>質問3は、おっしゃる通りで①のデータシートの最終行をI列(番号)に変更した方が良いと思いました。
dstend = Sh1.Cells(Rows.Count, 5).End(xlUp).Row
この行を
dstend = Sh1.Cells(Rows.Count, 9).End(xlUp).Row
に変えてください。(5を9に変更)
No.2
- 回答日時:
補足要求の追加です。
質問3)
①データシートの最終行はE列の最終行としてますが、
②データシートの最終行は”番号”の列の最終行を採用しています。
①データシートの最終行はI列(番号)の最終行でなくて良いのでしょうか。
質問4)
①データシートの番号は重複無しと考えて良いですか。
質問ありがとうございます。
質問3は、おっしゃる通りで①のデータシートの最終行をI列(番号)に変更した方が良いと思いました。
質問4は①データシート内の番号の重複は無しです。(②データシート内の番号の重複も無しです。)
宜しくお願い致します。
No.1
- 回答日時:
補足要求です。
質問1)
「①データ」シートには、差分チェックに入れたくない行のデータもあるのですが、
現状は「①データ」シートに番号があって「②データ」シートに番号がないと認識され「不一致」のメッセージと色がついてしまいます。
上記のケースが発生した場合に限り、
「①データ」シートのA~Dすべてのセルが空白の行の場合は「一致」で色がつかないようにするのですか?
それとも
質問2)
「①データ」シートのA~Dすべてのセルが空白の行の場合は、
そもそも、比較自体(処理、数量、価額の比較を含む)を行わないようにしたいのですか?
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・人生のプチ美学を教えてください!!
- ・10秒目をつむったら…
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・【大喜利】【投稿~9/18】 おとぎ話『桃太郎』の知られざるエピソード
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
excelの不要な行の削除ができな...
-
複数シートからデータを拾って...
-
エクセルファイルのシート毎の容量
-
Excelでシートの違うデータでグ...
-
シート削除して同名シート追加...
-
VBAで CTRL+HOMEの位置へ移動...
-
【エクセルマクロ】複数シート...
-
エクセル 縦に長い表の印刷時...
-
エクセルで1つのシートを拠点...
-
EXCEL グラフ作成 データの範...
-
複数シートのデータを行列を入...
-
マクロでの値貼り付けと参照シ...
-
Excelのセル横にリスト表示をす...
-
時間帯の重複を除いた集計について
-
Googleスプレッドシートフィル...
-
Excel データの自動読み込みに...
-
トランジスタの選び方
-
エクセル ピボットテーブルの...
-
エクセル2010 別シートへのデー...
-
重いExcelファイルのことで教え...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
excelの不要な行の削除ができな...
-
エクセルファイルのシート毎の容量
-
複数シートからデータを拾って...
-
Excelでシートの違うデータでグ...
-
シート削除して同名シート追加...
-
EXCELで2つのファイルから重複...
-
VBAで CTRL+HOMEの位置へ移動...
-
トランジスタの選び方
-
Excelで日付変更ごとに、自動的...
-
他のシートの一番下の行データ...
-
エクセル マクロ "特定の日付...
-
【エクセルマクロ】複数シート...
-
エクセル VBA VLOOKUP
-
時間帯の重複を除いた集計について
-
エクセル 縦に長い表の印刷時...
-
エクセルで名簿を50音で切り分ける
-
Excelマクロ 差分抽出の方法が...
-
エクセルのカメラ機能について
-
EXCEL 複数行のデータを1行にま...
-
Excel 売上管理シートに入力し...
おすすめ情報