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
0 hits

【18928】条件に合致した行を削除したいのですが・... michiko 04/10/16(土) 21:56 質問
【18930】Re:条件に合致した行を削除したいのですが... Hirofumi 04/10/16(土) 23:47 回答
【18931】Re:条件に合致した行を削除したいのですが... かみちゃん 04/10/17(日) 0:30 回答
【18939】ありがとうございました! michiko 04/10/17(日) 4:22 お礼

62409 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free