質問: 【VBA】複数の条件が一致したら特定の行を別のシートに移動と削除 VBA初心者です。ネットや書籍で調べてみて自分なりに試行錯誤しているのですが、どうしても思い通りにいきません。 良い方法をご教授いただけますと大変助かります。 よろしくお願いいたします。 sheet1とsheet2とsheet3(明細)と処理済シートの4つのシートがあります。 1sheet1で承認済となっている名前の合計金額を計算 2sheet2で承認済となっている名前の合計金額を計算 (1と同じ処理ですがシートが別です) 3sheet3(明細)の名前の合計金額を計算 4sheet1とsheet2で承認済となっている名前の合計金額とsheet3(明細)の名前の合計金額が一致した場合、sheet3(明細)のE列に完了と記載。 ※金額不一致の場合、エラーメッセージのポップを出し、処理を停止。(できれば名前単位でエラーがわかれば幸いですが、総合計での判定でも構いません) 5処理済みシートの一番下にsheet3(明細)の完了(E列)となっているものを行ごと切取りで移動 6sheet1とsheet2の承認済の行を削除 ※やりたいことは下記となります。 シート毎の承認済の合計金額と注文明細の合計金額が一致していることを確認した後に、sheet3(明細)で完了になっている行を処理済シートに移動とsheet11と2の承認済の行を削除をしたいです。 削除と移動はどちらが先でも問題ございません。 添付画像の左からsheet1、sheet2、sheet3(明細)となります。
回答: 合計金額が一致しないとメッセージがでます。 「無視」を選べば続行します。 それ以外は中止します。 Option Explicit ' Sub Macro1() Dim I As Worksheet Dim D As Worksheet Dim Sheet As Integer Dim IEnd As Long Dim RInp As Long Dim OEnd As Long Dim IName As String ' Set I = Sheets(3) Sheets(4).Select IEnd = I.Cells(Rows.Count, "A").End(xlUp).Row Application.ScreenUpdating = False I.AutoFilterMode = False ' For Sheet = 1 To 2 Set D = Sheets(Sheet) ' For RInp = 2 To D.Cells(Rows.Count, "A").End(xlUp).Row IName = D.Cells(RInp, "C") ' If D.Cells(RInp, "B") <> "承認済" Then ElseIf D.Cells(RInp, "D") = WorksheetFunction.SumIfs( _ I.[D:D], I.[B:B], IName, I.[E:E], "完了") Then OEnd = Cells(Rows.Count, "A").End(xlUp).Row I.Range("A1:E" & IEnd).AutoFilter 2, IName I.Range("A1:E" & IEnd).AutoFilter 5, "完了" I.Rows("2:" & IEnd).Copy Cells(OEnd + 1, "A") I.AutoFilterMode = False D.[A1:E1].Offset(RInp - 1).Delete xlUp ElseIf MsgBox("承認済と注文明細の合計金額が一致しません", _ vbExclamation + vbAbortRetryIgnore) <> vbIgnore Then D.Select Cells(RInp, "C").Select End End If Next RInp, Sheet End Sub