ExcelVBAで画像の様に動作を変更したいです
先日、こちらにて
教えていただいたマクロでのデータ突合方法を基にマクロを作成中なのですが、
画像の様に動作させるにはどう修正すればよいでしょうか
（目標）
画像のSheet1 と Sheet2の商品コードを上から順に突合し、
Sheet3に合致したA品番をコピー
Sheet4に合致したB品番をコピー
Sheet5に合致しなかったA品番をコピー
Sheet6に合致しなかったB品番をコピー
※なお、A品番B品番ともに同じ値の品番がいくつか存在することがある。
この場合は、ループ中既に合致したデータは対象から外す。
判別方法は品番の一つ横のセルに”〇”を表記。（フラグを立てる）
「A品番＝B品番」のとき「Offset(0, 1)が”〇”」ならば合致しない
---------------------------------------------------
（手順）
(1)Sheet1 あり Sheet2 ありの場合
→一致したSheet1とSheet2のOffset(0, 1)に”〇”
→一致したSheet1の行全体の値をSheet3にコピー
→一致したSheet2の行全体の値をSheet4にコピー
(2)Sheet1 あり Sheet2 なしの場合
→該当するSheet1の行全体の値をSheet5にコピー
(3)Sheet1 なし Sheet2 ありの場合
→該当するSheet2の行全体の値をSheet6にコピー
---------------------------------------------------
（現在のコード）
Sub Test()
Dim c As Range, FRange As Range
Dim Sh1 As Worksheet, Sh2 As Worksheet
Set Sh1 = Worksheets("Sheet1")
Set Sh2 = Worksheets("Sheet2")
For Each c In Sh1.Range(Sh1.Cells(3, "A"), Sh1.Cells(Rows.Count, "A").End(xlUp))
Set FRange = Sh2.Range(Sh2.Cells(3, "A"), Sh2.Cells(Rows.Count, "A").End(xlUp)). _
Find(c.Value, LookAt:=xlWhole, After:=Sh2.Cells(Rows.Count, "A").End(xlUp))
If Not FRange Is Nothing Then
If c.Value = FRange.Value And FRange.Offset(1, 0).Value <> "◯" Then
c.Offset(0, 1).Value = "◯"
'↓(1).xlsmSheet2に
Sheets("Sheet3").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Value = c.Value
FRange.Offset(0, 1).Value = "◯"
End If
Else
'↓(1).xlsmのSheet3に
Sheets("Sheet5").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Value = c.Value
End If
Next
For Each c In Sh2.Range(Sh2.Cells(3, "A"), Sh2.Cells(Rows.Count, "A").End(xlUp))
If c.Offset(0, 1).Value = "◯" Then
'↓(2).xlsmのSheet2に
Sheets("Sheet4").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Value = c.Value
Else
'↓(2).xlsmのSheet3に
Sheets("Sheet6").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Value = c.Value
End If
Next
End Sub
ご指導頂ければ幸いです。
お礼
kkkkkmさん ありがとうございます。 教えていただいた通り変更しましたら 思っていた通りに動きました。 IF～End With Elseで特定のセルのみ例外処理 すればよいのですねとても勉強になりました。 今月中に変更する必要があったので 本当に助かりました。 有難うございました。