Excel VBA質問箱 IV

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

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


62414 / 76738 ←次へ | 前へ→

【18931】Re:条件に合致した行を削除したいのですが・...
回答  かみちゃん  - 04/10/17(日) 0:30 -

引用なし
パスワード
   こんちには。かみちゃん です。

>「検収月」は毎月変わりますので「検収月を入力してください」という入力フォームを表示してユーザーに入力を促そうと考えていますが、
>条件設定になると、完全にお手上げです。

検収月入力部分は、Hirofumiさんご提示のコードを流用させていただきましたが、削除部分は、オートフィルタで一致した条件を削除しています。
特に、条件2の「検収月以外」というものは、「検収月の最初の日より小さく、検収月の末日より大きい」という条件にしているところがポイントです。

Option Explicit

Sub Macro1()
  Dim i As Long
  Dim strResult As String
  Dim dtmReceived1 As Date, dtmReceived2 As Date
 
  '検収月の入力
  Do
    strResult = InputBox("検収月を" & Format(Date, "yyyy/m") _
            & "の形で入力して下さい", "検収月入力", _
                Format(Date, "yyyy/m"))
    If strResult = "" Then
      Exit Sub
    Else
      If IsDate(strResult & "/1") Then
        '検収月の初日
        dtmReceived1 = DateValue(strResult & "/1")
        '検収月の末日
        dtmReceived2 = DateAdd("m", 1, DateValue(strResult & "/1")) - 1
        Exit Do
      Else
        Beep
        MsgBox "入力が違います"
      End If
    End If
  Loop
  
  '表の範囲がA1から始まるものとして
  Range("A1").CurrentRegion.AutoFilter
  '列Bが「処理済」を削除
  With ActiveSheet.AutoFilter.Range
    .AutoFilter Field:=2, Criteria1:="処理済"
    .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible) _
      .EntireRow.Delete Shift:=xlUp
  End With
  ActiveSheet.ShowAllData
  '列Fが「検収月」以外で、列Hが「1」の場合は削除
  With ActiveSheet.AutoFilter.Range
    .AutoFilter Field:=6, Criteria1:="<" & dtmReceived1, Operator:=xlOr, _
      Criteria2:=">" & dtmReceived2
    .AutoFilter Field:=8, Criteria1:="1"
    .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible) _
      .EntireRow.Delete Shift:=xlUp
  End With
  Selection.AutoFilter
  Range("A1").Select
End Sub

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 お礼

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