Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

62409 / 76732

←次へ　｜　前へ→


	【18930】Re:条件に合致した行を削除したいのですが・...

Hirofumi - 04/10/16(土) 23:47 -


	引用なし

	パスワード

こんなので善いのかな？

Public Sub DataDelete()

　　Dim i As Long
　　Dim strResult As String
　　Dim dtmReceived As Date
　　
　　Do
　　　　strResult = InputBox("検収月を" & Format(Date, "yyyy/m") _
　　　　　　　　　　　　& "の形で入力して下さい", "検収月入力", _
　　　　　　　　　　　　　　　　Format(Date, "yyyy/m"))
　　　　If strResult = "" Then
　　　　　　Exit Sub
　　　　Else
　　　　　　If IsDate(strResult & "/1") Then
　　　　　　　　dtmReceived = DateValue(strResult & "/1")
　　　　　　　　Exit Do
　　　　　　Else
　　　　　　　　Beep
　　　　　　　　MsgBox "入力が違います"
　　　　　　End If
　　　　End If
　　Loop
　　
　　Application.ScreenUpdating = False
　　
　　For i = Range("B65536").End(xlUp).Row To 2 Step -1
　　　　If RowDelete(Cells(i, "B").Value, _
　　　　　　　　Cells(i, "F").Value, _
　　　　　　　　　　Cells(i, "H").Value, dtmReceived) Then
　　　　　　Rows(i).Delete
　　　　End If
　　Next i
　　
　　Application.ScreenUpdating = True
　　
　　Beep
　　MsgBox "処理が完了しました"
　　
End Sub

Private Function RowDelete(vntOrder As Variant, _
　　　　　　　　　　　　　　vntDelivery As Variant, _
　　　　　　　　　　　　　　vntQuantity As Variant, _
　　　　　　　　　　　　　　dtmTop As Date) As Boolean

　　Dim dtmLast As Date
　　
　　dtmLast = DateSerial(Year(dtmTop), _
　　　　　　　　　　　　Month(dtmTop) + 1, 0)
　　RowDelete = True
　　
　　If vntOrder = "処理済" Then
　　　　Exit Function
　　End If
　　
　　If vntQuantity = 1 Then
　　　　If vntDelivery < dtmTop _
　　　　　　　　Or dtmLast < vntDelivery Then
　　　　　　Exit Function
　　　　End If
　　End If
　　
　　RowDelete = False
　　
End Function

1 hits

▼

【18928】条件に合致した行を削除したいのですが・... michiko 04/10/16(土) 21:56