エクセル2013 マクロ ご教示ください

質問

1行目は見出しです。
Sheet1のV列にSheet2のF列を反映させたいです。

条件は Sheet1のD列とN列とF列を検索値として
Sheet2のB列とG列とE列とが合致したら
Sheet1のV列にSheet2のF列を反映させたいです。

また、Sheet1のV列に反映させた後
Sheet2の該当行は削除したいです。

もしもSheet2に該当値が無かったらSheet1のV列には
ナシ の文字が入力されるようにお願いします。

Sheet1もSheet2も日々、最終行が違います。

回答No.2

tom04 · ベストアンサー

No.1です。

＞また、Sheet1のV列に反映させた後
＞Sheet2の該当行は削除したいです。

を見逃していました。

前回のコードは消去して、↓のコードに変更してください。
「★」の行を追加しています。

Sub Sample2()
Dim i As Long, c As Range, lastRow As Long, wS As Worksheet
Set wS = Worksheets("Sheet2")
Application.ScreenUpdating = False
lastRow = wS.Cells(Rows.Count, "B").End(xlUp).Row
wS.Range("A:A").Insert
Range(wS.Cells(2, "A"), wS.Cells(lastRow, "A")).Formula = "=C2&""_""&F2&""_""&H2"
With Worksheets("Sheet1")
For i = 2 To .Cells(Rows.Count, "D").End(xlUp).Row
Set c = wS.Range("A:A").Find(what:=.Cells(i, "D") & "_" & .Cells(i, "F") & "_" & .Cells(i, "N"), _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
.Cells(i, "V") = "ナシ"
Else
.Cells(i, "V") = wS.Cells(c.Row, "G")
wS.Cells(c.Row, "A").EntireRow.Delete shift:=xlUp '★
End If
Next i
End With
wS.Range("A:A").Delete
Application.ScreenUpdating = True
End Sub

失礼しました。m(_ _)m

お礼

動作確認しました。
思い通りの事ができました。
ありがとうございました。

回答No.1

tom04

こんばんは！

一例です。
Sheet1のV列表示形式は日付にしておいてください。

標準モジュールです。

Sub Sample1()
Dim i As Long, c As Range, lastRow As Long, wS As Worksheet
Set wS = Worksheets("Sheet2")
Application.ScreenUpdating = False
lastRow = wS.Cells(Rows.Count, "B").End(xlUp).Row
wS.Range("A:A").Insert
Range(wS.Cells(2, "A"), wS.Cells(lastRow, "A")).Formula = "=C2&""_""&F2&""_""&H2"
With Worksheets("Sheet1")
For i = 2 To .Cells(Rows.Count, "D").End(xlUp).Row
Set c = wS.Range("A:A").Find(what:=.Cells(i, "D") & "_" & .Cells(i, "F") & "_" & .Cells(i, "N"), _
LookIn:=xlValues, lookat:=xlWhole)
If c Is Nothing Then
.Cells(i, "V") = "ナシ"
Else
.Cells(i, "V") = wS.Cells(c.Row, "G")
End If
Next i
End With
wS.Range("A:A").Delete
Application.ScreenUpdating = True
End Sub

こんな感じではどうでしょうか？m(_ _)m