【Excel VBA】シート間で重複していない値を知りたい

質問

こんにちは。Excel VBAについてのご質問です。

「シートA」と「SheetB」があるのですが（同ブックです）、

・「SheetB」のE列の数値と「シートA」のC列の数値を見比べて
　「シートA」のC列にない数値があった場合、
　「SheetB」のその数値を含む行を赤色に変換する。

・上記の作業が終了したら「完了」というメッセージボックスを出す。

というマクロを組みたいのですがうまくいきません。
お分かりになる方がいらっしゃいましたら、ぜひお教え下さい。

宜しくお願い致します。

回答No.1

pkh4989 · ベストアンサー

こんにちは。

こんな感じでしょうか。

Sub シートCheck()
Dim ShA As Worksheet
Dim ShB As Worksheet
Dim wR1 As Long
Dim wR2 As Long
Dim wRng1 As Range
Dim wRng2 As Range
Dim c As Range
Dim c2 As Range
'
Application.ScreenUpdating = False
Set ShA = Worksheets("A")
Set ShB = Worksheets("B")
'
wR1 = ShA.Range("C" & Rows.Count).End(xlUp).Row
Set wRng1 = ShA.Range("C1:C" & wR1)
wR2 = ShB.Range("E" & Rows.Count).End(xlUp).Row
Set wRng2 = ShB.Range("E1:E" & wR2)

For Each c2 In wRng2
Set c = wRng1.Find(c2)
If c Is Nothing Then
ShB.Rows(c2.Row).Interior.ColorIndex = 3
End If
Next
Application.ScreenUpdating = True
msgbox "完了"
End Sub

お礼

早速のご回答、ありがとうございます！
希望通りの処理が出来ました。

ひとつひとつ、内容を理解していきたいと思います。
本当にありがとうございました。

回答No.3

TRX850-MDJ

あ、もういっぱい回答きてましたかＴ－Ｔ
初心者の私が書いてみたんで、どぞｗ
皆さんのと比べると恥ずかしいマクロですが、
初心者の私が作ったという点で共感が得られるかも
しれませんｗ

Sub なければ赤くするマクロ()

Dim 最終行 As Integer
Dim 行 As Integer

Application.ScreenUpdating = False '表示をとめまーす

最終行 = Range("E65536").End(xlUp).Row '最終行は何行目か
行 = 1 '１行目からスタートします
Do Until 行 > 最終行 '１行目から最終行まで繰り返し

ありなし = Application.CountIf(Worksheets("SheetA").Range("C:C"), Cells(行, 5))
'ココでデータ個数を「ありなし」に代入します

If ありなし = 0 Then 'データ個数が０（つまりナシ）なら以下の行動、ちがければEND IF以降へ
Rows(行).Select '選択しているセルの行に
Selection.Interior.ColorIndex = 3 '赤い色をつける
End If

行 = 行 + 1 '行数をひとつ増やして、ループします。最終行まで繰り返し
Loop

Range("a1").Select
Application.ScreenUpdating = True '表示を再開しまーす
MsgBox "完了" '完了～^^

End Sub

お礼

ご回答、ありがとうございました！
一文一文の説明が大変わかりやすくて助かりました！

回答No.2

merlionXX

Sub test01()
Dim wsA As Worksheet, wsB As Worksheet
Dim x As Long, i As Long

Set wsA = Sheets("シートA")
Set wsB = Sheets("SheetB")
x = wsB.Cells(Rows.Count, "E").End(xlUp).Row

For i = 1 To x

If wsB.Cells(i, "E").Value <> "" Then
If wsA.Columns("C").Find(What:=wsB.Cells(i, "E").Value, LookIn:=xlValues, LookAt:= _
xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, MatchByte:=False) Is Nothing Then
wsB.Rows(i).Interior.ColorIndex = 3
End If
End If

Next

MsgBox "終わったわ。", , " o(^-^)o"

End Sub

って感じでしょうか。