Option Explicit
    Dim ms As Worksheet     '明細シート
    Dim sz As Worksheet     '処理済シート
    Dim maxrow_ms As Long   '明細最大行
    Dim maxrow_sz As Long   '処理済最大行
    Dim count As Long       '処理件数
 
Public Sub 更新処理()
    Dim ret As Integer
    Set ms = Worksheets("明細")
    Set sz = Worksheets("処理済")
    maxrow_ms = ms.Cells(Rows.count, 1).End(xlUp).Row    'A列 最大行取得
    maxrow_sz = sz.Cells(Rows.count, 1).End(xlUp).Row    'A列 最大行取得
    count = 0
    ms.Range("E2:E" & maxrow_ms).Value = "" '状態クリア
    Call check_status("建物")  '建物シートのチェック
    Call check_status("機械")  '機械シートのチェック
    If count = 0 Then
        MsgBox ("処理済データなし")
        Exit Sub
    End If
    ret = MsgBox("処理件数=" & count & vbLf & "完了データの移動及び処理済データの削除を開始します", vbOKCancel)
    If ret = vbCancel Then Exit Sub
    Call delete_line("建物")    '建物シートの処理済み行削除
    Call delete_line("機械")    '機械シートの処理済み行削除
    Call copy_compline          '完了行のコピー
    Call delete_compline        '完了行の削除
    MsgBox ("処理完了")
End Sub
'処理済行のチェック
Private Sub check_status(ByVal sheet_name As String)
    Dim maxrow As Long
    Dim ws As Worksheet
    Dim wrow As Long
    Dim result As Boolean
    Dim name As String
    Dim kingaku As Variant
    Dim errmsg As String
    errmsg = ""
    Set ws = Worksheets(sheet_name)
    maxrow = ws.Cells(Rows.count, 2).End(xlUp).Row    'B列 最大行取得
    For wrow = 2 To maxrow
        If ws.Cells(wrow, "B").Value = "処理済" Then
            name = ws.Cells(wrow, "C").Value
            kingaku = ws.Cells(wrow, "D").Value
            If kingaku = "" Then errmsg = "合計金額が空です"
            If name = "" Then errmsg = "名前が空です"
            If errmsg = "" Then
                Call check_kingaku(name, kingaku, errmsg)   '合計金額のチェック
            End If
            'エラーがあればエラーメッセージ表示後、処理中止
            If errmsg <> "" Then
                MsgBox ("シート名=" & sheet_name & " " & wrow & "行" & vbLf & errmsg & vbLf & "処理を打ち切ります")
                ws.Select
                ws.Cells(wrow, "B").Select
                End
            End If
        End If
    Next
End Sub
 
'金額チェック
Private Sub check_kingaku(ByVal name As String, ByVal kingaku As Variant, ByRef errmsg As String)
    Dim wrow As Long
    Dim find As Boolean
    Dim sum_kingaku As Variant
    Dim row_count As Long
    Dim row_array() As Long
    Dim i As Long
    row_count = -1
    find = False
    sum_kingaku = 0
    For wrow = 2 To maxrow_ms
        If ms.Cells(wrow, "E").Value = "" And ms.Cells(wrow, "B").Value = name Then
            sum_kingaku = sum_kingaku + ms.Cells(wrow, "D").Value
            row_count = row_count + 1
            ReDim Preserve row_array(row_count)
            row_array(row_count) = wrow
            find = True
        End If
    Next
    If find = True Then
        If kingaku = sum_kingaku Then
            For i = 0 To UBound(row_array)
                wrow = row_array(i)
                ms.Cells(wrow, "E").Value = "完了"
            Next
            count = count + 1
        Else
            errmsg = "合計金額が不一致です"
        End If
    Else
        errmsg = "名前が不一致です"
    End If
End Sub
 
'処理済行の削除
Private Sub delete_line(ByVal sheet_name As String)
    Dim maxrow As Long
    Dim ws As Worksheet
    Dim wrow As Long
    Set ws = Worksheets(sheet_name)
    maxrow = ws.Cells(Rows.count, 2).End(xlUp).Row    'B列 最大行取得
    For wrow = maxrow To 2 Step -1
        If ws.Cells(wrow, "B").Value = "処理済" Then
            ws.Rows(wrow).Delete
        End If
    Next
End Sub
 
'完了行のコピー
Private Sub copy_compline()
    Dim wrow As Long
    Dim wrow2 As Long
    wrow2 = maxrow_sz
    For wrow = 2 To maxrow_ms
        If ms.Cells(wrow, "E").Value = "完了" Then
            sz.Range("A" & wrow2 & ":E" & wrow2).Value = ms.Range("A" & wrow & ":E" & wrow).Value
            wrow2 = wrow2 + 1
        End If
    Next
End Sub
 
'完了行の削除
Private Sub delete_compline()
    Dim wrow As Long
    Dim wrow2 As Long
    wrow2 = maxrow_sz
    For wrow = maxrow_ms To 2 Step -1
        If ms.Cells(wrow, "E").Value = "完了" Then
            ms.Rows(wrow).Delete
        End If
    Next
End Sub
 
 

T3B0aW9uIEV4cGxpY2l0CiAgICBEaW0gbXMgQXMgV29ya3NoZWV0ICAgICAn5piO57Sw44K344O844OICiAgICBEaW0gc3ogQXMgV29ya3NoZWV0ICAgICAn5Yem55CG5riI44K344O844OICiAgICBEaW0gbWF4cm93X21zIEFzIExvbmcgICAn5piO57Sw5pyA5aSn6KGMCiAgICBEaW0gbWF4cm93X3N6IEFzIExvbmcgICAn5Yem55CG5riI5pyA5aSn6KGMCiAgICBEaW0gY291bnQgQXMgTG9uZyAgICAgICAn5Yem55CG5Lu25pWwCgpQdWJsaWMgU3ViIOabtOaWsOWHpueQhigpCiAgICBEaW0gcmV0IEFzIEludGVnZXIKICAgIFNldCBtcyA9IFdvcmtzaGVldHMoIuaYjue0sCIpCiAgICBTZXQgc3ogPSBXb3Jrc2hlZXRzKCLlh6bnkIbmuIgiKQogICAgbWF4cm93X21zID0gbXMuQ2VsbHMoUm93cy5jb3VudCwgMSkuRW5kKHhsVXApLlJvdyAgICAnQeWIlyDmnIDlpKfooYzlj5blvpcKICAgIG1heHJvd19zeiA9IHN6LkNlbGxzKFJvd3MuY291bnQsIDEpLkVuZCh4bFVwKS5Sb3cgICAgJ0HliJcg5pyA5aSn6KGM5Y+W5b6XCiAgICBjb3VudCA9IDAKICAgIG1zLlJhbmdlKCJFMjpFIiAmIG1heHJvd19tcykuVmFsdWUgPSAiIiAn54q25oWL44Kv44Oq44KiCiAgICBDYWxsIGNoZWNrX3N0YXR1cygi5bu654mpIikgICflu7rnianjgrfjg7zjg4jjga7jg4Hjgqfjg4Pjgq8KICAgIENhbGwgY2hlY2tfc3RhdHVzKCLmqZ/morAiKSAgJ+apn+aisOOCt+ODvOODiOOBruODgeOCp+ODg+OCrwogICAgSWYgY291bnQgPSAwIFRoZW4KICAgICAgICBNc2dCb3ggKCLlh6bnkIbmuIjjg4fjg7zjgr/jgarjgZciKQogICAgICAgIEV4aXQgU3ViCiAgICBFbmQgSWYKICAgIHJldCA9IE1zZ0JveCgi5Yem55CG5Lu25pWwPSIgJiBjb3VudCAmIHZiTGYgJiAi5a6M5LqG44OH44O844K/44Gu56e75YuV5Y+K44Gz5Yem55CG5riI44OH44O844K/44Gu5YmK6Zmk44KS6ZaL5aeL44GX44G+44GZIiwgdmJPS0NhbmNlbCkKICAgIElmIHJldCA9IHZiQ2FuY2VsIFRoZW4gRXhpdCBTdWIKICAgIENhbGwgZGVsZXRlX2xpbmUoIuW7uueJqSIpICAgICflu7rnianjgrfjg7zjg4jjga7lh6bnkIbmuIjjgb/ooYzliYrpmaQKICAgIENhbGwgZGVsZXRlX2xpbmUoIuapn+aisCIpICAgICfmqZ/morDjgrfjg7zjg4jjga7lh6bnkIbmuIjjgb/ooYzliYrpmaQKICAgIENhbGwgY29weV9jb21wbGluZSAgICAgICAgICAn5a6M5LqG6KGM44Gu44Kz44OU44O8CiAgICBDYWxsIGRlbGV0ZV9jb21wbGluZSAgICAgICAgJ+WujOS6huihjOOBruWJiumZpAogICAgTXNnQm94ICgi5Yem55CG5a6M5LqGIikKRW5kIFN1Ygon5Yem55CG5riI6KGM44Gu44OB44Kn44OD44KvClByaXZhdGUgU3ViIGNoZWNrX3N0YXR1cyhCeVZhbCBzaGVldF9uYW1lIEFzIFN0cmluZykKICAgIERpbSBtYXhyb3cgQXMgTG9uZwogICAgRGltIHdzIEFzIFdvcmtzaGVldAogICAgRGltIHdyb3cgQXMgTG9uZwogICAgRGltIHJlc3VsdCBBcyBCb29sZWFuCiAgICBEaW0gbmFtZSBBcyBTdHJpbmcKICAgIERpbSBraW5nYWt1IEFzIFZhcmlhbnQKICAgIERpbSBlcnJtc2cgQXMgU3RyaW5nCiAgICBlcnJtc2cgPSAiIgogICAgU2V0IHdzID0gV29ya3NoZWV0cyhzaGVldF9uYW1lKQogICAgbWF4cm93ID0gd3MuQ2VsbHMoUm93cy5jb3VudCwgMikuRW5kKHhsVXApLlJvdyAgICAnQuWIlyDmnIDlpKfooYzlj5blvpcKICAgIEZvciB3cm93ID0gMiBUbyBtYXhyb3cKICAgICAgICBJZiB3cy5DZWxscyh3cm93LCAiQiIpLlZhbHVlID0gIuWHpueQhua4iCIgVGhlbgogICAgICAgICAgICBuYW1lID0gd3MuQ2VsbHMod3JvdywgIkMiKS5WYWx1ZQogICAgICAgICAgICBraW5nYWt1ID0gd3MuQ2VsbHMod3JvdywgIkQiKS5WYWx1ZQogICAgICAgICAgICBJZiBraW5nYWt1ID0gIiIgVGhlbiBlcnJtc2cgPSAi5ZCI6KiI6YeR6aGN44GM56m644Gn44GZIgogICAgICAgICAgICBJZiBuYW1lID0gIiIgVGhlbiBlcnJtc2cgPSAi5ZCN5YmN44GM56m644Gn44GZIgogICAgICAgICAgICBJZiBlcnJtc2cgPSAiIiBUaGVuCiAgICAgICAgICAgICAgICBDYWxsIGNoZWNrX2tpbmdha3UobmFtZSwga2luZ2FrdSwgZXJybXNnKSAgICflkIjoqIjph5HpoY3jga7jg4Hjgqfjg4Pjgq8KICAgICAgICAgICAgRW5kIElmCiAgICAgICAgICAgICfjgqjjg6njg7zjgYzjgYLjgozjgbDjgqjjg6njg7zjg6Hjg4Pjgrvjg7zjgrjooajnpLrlvozjgIHlh6bnkIbkuK3mraIKICAgICAgICAgICAgSWYgZXJybXNnIDw+ICIiIFRoZW4KICAgICAgICAgICAgICAgIE1zZ0JveCAoIuOCt+ODvOODiOWQjT0iICYgc2hlZXRfbmFtZSAmICIgIiAmIHdyb3cgJiAi6KGMIiAmIHZiTGYgJiBlcnJtc2cgJiB2YkxmICYgIuWHpueQhuOCkuaJk+OBoeWIh+OCiuOBvuOBmSIpCiAgICAgICAgICAgICAgICB3cy5TZWxlY3QKICAgICAgICAgICAgICAgIHdzLkNlbGxzKHdyb3csICJCIikuU2VsZWN0CiAgICAgICAgICAgICAgICBFbmQKICAgICAgICAgICAgRW5kIElmCiAgICAgICAgRW5kIElmCiAgICBOZXh0CkVuZCBTdWIKCifph5HpoY3jg4Hjgqfjg4Pjgq8KUHJpdmF0ZSBTdWIgY2hlY2tfa2luZ2FrdShCeVZhbCBuYW1lIEFzIFN0cmluZywgQnlWYWwga2luZ2FrdSBBcyBWYXJpYW50LCBCeVJlZiBlcnJtc2cgQXMgU3RyaW5nKQogICAgRGltIHdyb3cgQXMgTG9uZwogICAgRGltIGZpbmQgQXMgQm9vbGVhbgogICAgRGltIHN1bV9raW5nYWt1IEFzIFZhcmlhbnQKICAgIERpbSByb3dfY291bnQgQXMgTG9uZwogICAgRGltIHJvd19hcnJheSgpIEFzIExvbmcKICAgIERpbSBpIEFzIExvbmcKICAgIHJvd19jb3VudCA9IC0xCiAgICBmaW5kID0gRmFsc2UKICAgIHN1bV9raW5nYWt1ID0gMAogICAgRm9yIHdyb3cgPSAyIFRvIG1heHJvd19tcwogICAgICAgIElmIG1zLkNlbGxzKHdyb3csICJFIikuVmFsdWUgPSAiIiBBbmQgbXMuQ2VsbHMod3JvdywgIkIiKS5WYWx1ZSA9IG5hbWUgVGhlbgogICAgICAgICAgICBzdW1fa2luZ2FrdSA9IHN1bV9raW5nYWt1ICsgbXMuQ2VsbHMod3JvdywgIkQiKS5WYWx1ZQogICAgICAgICAgICByb3dfY291bnQgPSByb3dfY291bnQgKyAxCiAgICAgICAgICAgIFJlRGltIFByZXNlcnZlIHJvd19hcnJheShyb3dfY291bnQpCiAgICAgICAgICAgIHJvd19hcnJheShyb3dfY291bnQpID0gd3JvdwogICAgICAgICAgICBmaW5kID0gVHJ1ZQogICAgICAgIEVuZCBJZgogICAgTmV4dAogICAgSWYgZmluZCA9IFRydWUgVGhlbgogICAgICAgIElmIGtpbmdha3UgPSBzdW1fa2luZ2FrdSBUaGVuCiAgICAgICAgICAgIEZvciBpID0gMCBUbyBVQm91bmQocm93X2FycmF5KQogICAgICAgICAgICAgICAgd3JvdyA9IHJvd19hcnJheShpKQogICAgICAgICAgICAgICAgbXMuQ2VsbHMod3JvdywgIkUiKS5WYWx1ZSA9ICLlrozkuoYiCiAgICAgICAgICAgIE5leHQKICAgICAgICAgICAgY291bnQgPSBjb3VudCArIDEKICAgICAgICBFbHNlCiAgICAgICAgICAgIGVycm1zZyA9ICLlkIjoqIjph5HpoY3jgYzkuI3kuIDoh7TjgafjgZkiCiAgICAgICAgRW5kIElmCiAgICBFbHNlCiAgICAgICAgZXJybXNnID0gIuWQjeWJjeOBjOS4jeS4gOiHtOOBp+OBmSIKICAgIEVuZCBJZgpFbmQgU3ViCgon5Yem55CG5riI6KGM44Gu5YmK6ZmkClByaXZhdGUgU3ViIGRlbGV0ZV9saW5lKEJ5VmFsIHNoZWV0X25hbWUgQXMgU3RyaW5nKQogICAgRGltIG1heHJvdyBBcyBMb25nCiAgICBEaW0gd3MgQXMgV29ya3NoZWV0CiAgICBEaW0gd3JvdyBBcyBMb25nCiAgICBTZXQgd3MgPSBXb3Jrc2hlZXRzKHNoZWV0X25hbWUpCiAgICBtYXhyb3cgPSB3cy5DZWxscyhSb3dzLmNvdW50LCAyKS5FbmQoeGxVcCkuUm93ICAgICdC5YiXIOacgOWkp+ihjOWPluW+lwogICAgRm9yIHdyb3cgPSBtYXhyb3cgVG8gMiBTdGVwIC0xCiAgICAgICAgSWYgd3MuQ2VsbHMod3JvdywgIkIiKS5WYWx1ZSA9ICLlh6bnkIbmuIgiIFRoZW4KICAgICAgICAgICAgd3MuUm93cyh3cm93KS5EZWxldGUKICAgICAgICBFbmQgSWYKICAgIE5leHQKRW5kIFN1YgoKJ+WujOS6huihjOOBruOCs+ODlOODvApQcml2YXRlIFN1YiBjb3B5X2NvbXBsaW5lKCkKICAgIERpbSB3cm93IEFzIExvbmcKICAgIERpbSB3cm93MiBBcyBMb25nCiAgICB3cm93MiA9IG1heHJvd19zegogICAgRm9yIHdyb3cgPSAyIFRvIG1heHJvd19tcwogICAgICAgIElmIG1zLkNlbGxzKHdyb3csICJFIikuVmFsdWUgPSAi5a6M5LqGIiBUaGVuCiAgICAgICAgICAgIHN6LlJhbmdlKCJBIiAmIHdyb3cyICYgIjpFIiAmIHdyb3cyKS5WYWx1ZSA9IG1zLlJhbmdlKCJBIiAmIHdyb3cgJiAiOkUiICYgd3JvdykuVmFsdWUKICAgICAgICAgICAgd3JvdzIgPSB3cm93MiArIDEKICAgICAgICBFbmQgSWYKICAgIE5leHQKRW5kIFN1YgoKJ+WujOS6huihjOOBruWJiumZpApQcml2YXRlIFN1YiBkZWxldGVfY29tcGxpbmUoKQogICAgRGltIHdyb3cgQXMgTG9uZwogICAgRGltIHdyb3cyIEFzIExvbmcKICAgIHdyb3cyID0gbWF4cm93X3N6CiAgICBGb3Igd3JvdyA9IG1heHJvd19tcyBUbyAyIFN0ZXAgLTEKICAgICAgICBJZiBtcy5DZWxscyh3cm93LCAiRSIpLlZhbHVlID0gIuWujOS6hiIgVGhlbgogICAgICAgICAgICBtcy5Sb3dzKHdyb3cpLkRlbGV0ZQogICAgICAgIEVuZCBJZgogICAgTmV4dApFbmQgU3ViCgo=