[[20040628231744]]　『Findとループ』（夏目雅子似）　ページの最後に飛ぶ

『Findとループ』（夏目雅子似）

 『VBAで行を削除...』（TTC） 
 さんの質問に答えていたら、途中でわからなくなってしまったので
 どなたか教えていただけないでしょうか？
  H列に「3」がある間はループしてほしいんですけど、、ギブアップですぅ(>_<)
 Sub オートフィルターで抽出削除()
 Dim MyR As Range 'データ範囲をRangeで宣言
 Dim CNo As Variant  'キャンセルNoの格納箱
 Dim i As Integer
 Dim MyCNo As Integer  'キャンセルNoの種類
 Dim MyData As Variant  'キャンセルNo.が3の時のC列の値
 Dim MyDataRng As Range  '抽出後の範囲
 Dim x As Range   'キャンセル条件「3」を変数にします。

 Application.ScreenUpdating = False  '画面の更新停止

 CNo = Array(1, 2, 5, 9)  '配列を格納

 Set MyR = Range("A1").CurrentRegion  'データ範囲の取得

    If AutoFilterMode = True Then  'オートフィルターがONだったらOFF
        AutoFilterMode = False
    End If

    For i = 0 To 4
        MyCNo = CNo(i)
              With MyR
                .AutoFilter Field:=8, _
                Criteria1:="=" & MyCNo  'キャンセルNo.を入れ替えて抽出

                On Error Resume Next

                .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count). _
                SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp  '抽出結果を 見出しを残して削除
              End With
        AutoFilterMode = False  'フィルターOFF
    Next

'ここまでで、1,2,5,9のキャンセルデータを削除

 Do '「結果的にキャンセルNo3が無くなるまでループ」の始まり

 Columns("H:H").Select

    Set x = Selection.Find(What:="3", After:=ActiveCell, LookIn:=xlValues,  LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , MatchByte:=False).Activate

    With MyR
        .AutoFilter Field:=8, Criteria1:="=3"     'キャンセルNo3で抽出

            Set MyDataRng = .Resize(.Rows.Count - 1).Offset(1) _
            .SpecialCells(xlCellTypeVisible)  '抽出した範囲の可視セル範囲の最上行を取得

            MsgBox MyDataRng.Row  '抽出した範囲の可視セル範囲の最上行を表示

        MyData = Cells(MyDataRng.Row, 3).Value  'キャンセルNo.3に該当するC列の値を取得
    End With

    MsgBox MyData  'キャンセルNo.3に該当するC列の値を表示

   AutoFilterMode = False  'フィルターOFF

    With MyR
        .AutoFilter Field:=3, Criteria1:="=" & MyData  'キャンセルNo.3に該当するC列の値で抽出

            On Error Resume Next

        .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count). _
        SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp  '抽出結果を見出しを残して削除
    End With

    AutoFilterMode = False  'フィルターOFF

 Loop Until x = ?   '「キャンセルNo3が無くなるまでループ」の終わり

 '以下は全て不要

 '    With MyR
 '        .AutoFilter Field:=8, Criteria1:="3" 'キャンセルNo.3で抽出
 '
 '            'On Error Resume Next
 '
 '        .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count). _
 '        SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp  '抽出結果を見出しを 残して削除
 '    End With
 '
 '        AutoFilterMode = False  'フィルターOFF

 Application.ScreenUpdating = True '画面の更新解除

 Set MyR = Nothing  '変数のクリア
 Set MyDataRng = Nothing  '変数のクリア

 End Sub

 お騒がせしました。一晩寝ましたら解決しました(･･;)
（夏目雅子似）

コメント返信：

[ 一覧(最新更新順) ]

[[20040628231744]] 『Findとループ』（夏目雅子似） ページの最後に飛ぶ

[[20040628231744]]　『Findとループ』（夏目雅子似）　ページの最後に飛ぶ