[[20040627164919]]　『VBAで行を削除...』（TTC）　ページの最後に飛ぶ

『VBAで行を削除...』（TTC）

ご質問させてください。
CSVファイルからデータを取り込んで加工したいのですが
C列に注文NO(8桁)、H列にキャンセルコード（空白と1から9の数字が入っています）
他の列は特に見ないので省略します。
まずキャンセルコードが("1"か"2"か"5"か"9")のときはその行を削除し、
キャンセルコードが"3"のときはその行と同じ注文NOの行も同時に削除。
ということがしたいのです。
本などを見ながら勉強しているのですがうまくあてはまるコードが
なく、どなたか教えていただけないでしょうか？

 OS と Excel のバージョンはなんでしょうか？

 あと CSV は、行数が少ないのでしょうか？
 だとすれば、開いた後に、
 for ～ Next でループ処理しながら
 If文で判定して、削除すればよいと思います。

 行数が多い時（65536以上）は、行削除するのではなく、 
 該当する項目のみ読み込むという事も出来ます。
 ちょっと難しいですが・・

  (INA)

早速のご回答ありがとうございます。
OS は　Win Me で　Excel は 2000 です。
行数は20000行位です。
以下は自分でやってみて全く作動しなかったものです。

Sub macro1()

Dim gyo As Long
Dim Rng As Range
Dim sakujo As Long
Application.ScreenUpdating = False

For gyo = Cells(65536, 8).End(xlUp).Row To 2 Step -1

 Set Rng = Range("H8", Range("H65536").End(xlUp))

If Cells(gyo, 8) = 1 Then

    Rows(gyo).Delete shift:=xlUp
ElseIf Cells(gyo, 8) = 2 Then
    Rows(gyo).Delete shift:=xlUp
ElseIf Cells(gyo, 8) = 5 Then
    Rows(gyo).Delete shift:=xlUp
ElseIf Cells(gyo, 8) = 4 Then
    Rows(gyo).Delete shift:=xlUp
ElseIf Cells(gyo, 8) = 5 Then
    Rows(gyo).Delete shift:=xlUp
ElseIf Cells(gyo, 8) = 9 Then
    Rows(gyo).Delete shift:=xlUp

ElseIf Cells(gyo, 8) = 3 Then

    Rows(gyo - 1).Delete shift:=xlUp
    Rows(gyo).Delete shift:=xlUpEnd If

End If

    Next gyo

少し作り変えてみましたが1行だけのこして全部削除されてしまします。
どこがおかしいでしょうか？

End Sub

 20000行あるとなると、ループだと時間が掛かるので、 
 オートフィルタを使った方がよいかと思います。

 H列で、1,2,5,9 で4回フィルタを繰り返しつつ、抽出された行を削除。
 次に、3 でフィルタして、抽出された行のC列の値（注文NO）を取得。
 このとき配列変数もしくは、Dictionaryオブジェクトに格納する。
 そして取得した値をキーに、 オートフィルタ＆行削除を繰り返す。

 このような感じで出来るかと思います。

 ひたすらFor～Nextでも出来ると思いますが、
 かなり時間が掛かってしまうと思われます。

  (INA)

 INAさんありがとうございます。
オートフィルターで記録してやってみました。
Range("H3").Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=8, Criteria1:="1"
    Selection.Delete Shift:=xlUp
    Selection.AutoFilter Field:=8, Criteria1:="2"
    Selection.Delete Shift:=xlUp
    Selection.AutoFilter Field:=8, Criteria1:="4"
    Selection.Delete Shift:=xlUp
    Selection.AutoFilter Field:=8, Criteria1:="5"
    Selection.Delete Shift:=xlUp
    Selection.AutoFilter Field:=8, Criteria1:="9"
    Selection.Delete Shift:=xlUp

どうもうまく削除されないようなのですが・・・？
なにか足りないのでしょうか？
素人で申し訳ございません。
　「次に、3 でフィルタして、抽出された行のC列の値（注文NO）を取得。」
　「このとき配列変数もしくは、Dictionaryオブジェクトに格納する。」
　「そして取得した値をキーに、オートフィルタ＆行削除を繰り返す。」
このところももう少し教えていただけたらと思います。
よろしくお願いいたします。

 前半のコードです。

 Sub Sample1()
 Dim myKey As Variant
 Dim i As Long

    myKey = Array("1", "2", "5", "9")

    For i = 0 To 3

        'フィルタ
        Range("A1").CurrentRegion.AutoFilter Field:=8, Criteria1:=myKey(i)

        '行削除
        UsedRange.Offset(1).Select
        Selection.Resize(Selection.Rows.Count - 1, Selection.Columns.Count). _
        SpecialCells(xlCellTypeVisible).EntireRow.Delete Shift:=xlUp

    Next i

    AutoFilterMode = False

 End Sub

  (INA)

 はぁ～い！！横からお邪魔します。
 とても人様にお見せできる様なコードじゃないんですが、、、
 例によって動けばいいじゃんマクロでよければ使ってみておくんなましぃm(__)m
 あっつ！！今回は絶対にバックアップをとっておいてくださいね。
 では、、清水の舞台よりダイブします。外してたら、、ごめんさないね。m(__)m
 あまり、動作確認していません。最後までお付き合いできないとおもいますが、、
 とりあえず、たたきだいということでお願いいたします。

 あっ、、シートに貼り付けてください。

 びじゅあるべしっくふぉぁあぷりけいしょん、、むつかしい。。
 でも、、おぼえたい←こんなフレーズあった様な(^^ゞ

 追伸、皆様、夏のお題提出はお済にまりましたか？

 (夏目雅子似）

 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  '抽出後の範囲

 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 Until MyData = ""     '「キャンセルNo3で抽出した時のC列の値が無くなるまでループ」の始まり

    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  '「キャンセルNo3で抽出した時のC列の値が無くなるまでループ」の終わり

    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

　すごいコード、ありがとうございます。
キャンセルNOのある行は削除されました。
その次のC列の値の抽出して削除がされませんでした。
あと最後、オートフィルターOFFのコードでフィルターは
解除されるのではないのですか？
最後そのまま残ってしまいました。
何が原因でしょうか？

 うぅ～ん、はっきり言ってよくわかりません。
 私の模擬データでは削除されているのですが、、、
 データの型があわないのかもしれません。
 On Error Resume Nextが入っているので、出来れば削除された部分のコードを
 変数は残して全てコメント化してLoopの入り口から、F8で一づつみていかれては
 いかがでしょうか？無責任な回答で申し訳ありません。m(__)m
 （夏目雅子似）

 後、あるとすれば、3のところが、"=3"でしょうか？
 でも、記録されても削除されないのは？？？？
 With MyR
        .AutoFilter Field:=8, Criteria1:="=3" 'キャンセルNo.3で抽出
　　　　　　　　　　　　　　　　　　　　　　　↑
 かなり山勘ですぅ^_^;
　(夏目雅子似）

　F8で見ていったところ、
　ループの入り口の次にループの終わりの後の

 With MyR　に飛んでしまっているようです。
 だからC列を記憶しないのでしょうか？
（TTC）すいません名前も入れてないですね・・・。

あぁぁぁぁぁ、、、すみません。ループの入り口と出口を

 ↓の様に変えてください。
 やっぱり、私、、らしいわ(>_<)

 だめだこりゃ、、

↓

 Do '「キャンセルNo3で抽出した時のC列の値が無くなるまでループ」の始まり

    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 MyData = ""     '「キャンセルNo3で抽出した時のC列の値が無くなるまでループ」の終わり
　　　　　　　　　　　　　　　　　　　　　　　
↑
 なんで、こうすべるかなぁ、、、(･･;)
（夏目雅子似)

　何度もありがとうございます。
　今度はループから抜けられなくなってしまいました。
　最後同じデータを拾ってそれを繰り返してしまいます。
　スイマセン・・・。
　(TTC)

 すみませんm(__)m条件がちがいますよね？
 検索条件の「3」がなくなるまで？ですよね？
 私が、ヘルプみぃ～だわ(･･;)

 おまたぁっせ～～～～！！
 これで、多分いいと思いますが、、答えがあってるかな？
 あぁ、、だんだん動けばいいじゃんマクロじゃなくなってきた(･･;)
 まぁ、、許しておくんなましぃm(__)m
 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 Integer  'キャンセル条件「3」を変数にします。
 x = 3 '最初に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が無くなるまでループ」の始まり

    With MyR
        .AutoFilter Field:=8, Criteria1:=x     'キャンセル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

 本当にありがとうございます。
 自分でもいろいろいじってみたのですが・・・。
 作っていただいたものでやったのですが、
 On Error Resume Next
 にいくということはエラーですか？
 うぅぅ・・難しいですね。
 どうやらC列を抽出してくれてないようです。
　(TTC)

 すいません(INA)さんありがとうございます
 衝突してしまい先にいれてしまいました。
 早速、やってみたいとおもいます。

 後半部分も書いておきます。 標準モジュール用に修正しました。

 Sub Sample1()
 Dim myKey As Variant
 Dim i As Long

 With ActiveSheet
    myKey = Array("1", "2", "5", "9")

    For i = 0 To 3
        'フィルタ
        .Range("A1").CurrentRegion.AutoFilter Field:=8, Criteria1:=myKey(i)

        '行削除
        .UsedRange.Offset(1).Select
        Selection.Resize(Selection.Rows.Count - 1, Selection.Columns.Count). _
        SpecialCells(xlCellTypeVisible).EntireRow.Delete Shift:=xlUp
    Next i

    .AutoFilterMode = False
    Call Sample2 '後半部分を実行

 End With
 End Sub

 Sub Sample2()
 Dim myDic As Variant
 Dim ret As Variant
 Dim r As Range
 Dim i As Long

 With ActiveSheet

    .Range("A1").CurrentRegion.AutoFilter Field:=8, Criteria1:="3"

    Set myDic = CreateObject("Scripting.Dictionary")

        On Error Resume Next
        For Each r In .UsedRange.Columns(3).SpecialCells(xlCellTypeVisible)
            myDic.Add r.Value, ""
        Next r

    .AutoFilterMode = False
    ret = myDic.keys

    For i = 1 To myDic.Count - 1
        'フィルタ
        .Range("A1").CurrentRegion.AutoFilter Field:=3, Criteria1:=ret(i)

        '行削除
        .UsedRange.Offset(1).Select
        Selection.Resize(Selection.Rows.Count - 1, Selection.Columns.Count). _
        SpecialCells(xlCellTypeVisible).EntireRow.Delete Shift:=xlUp
    Next i

    .AutoFilterMode = False
 End With
 End Sub

   (INA)

 (INA)さんすいません。

 会社がしまってしまうので
 続きは家で行いたいと思います。
 (夏目雅子似？)さん,(INA)さん
 お付き合いいただき本当にありがとうございます。
 帰るのに１時間くらいかかるので
 すぐにお返事できないですが、
 よろしくお願いいたします。

 あっ、遅くなっては申し訳ないので、
 別のご都合の良い日でもよいです。
 必ず結果ご連絡いたします。
 (TTC)

 (INA)さんどうやらうまくいきそうです。
 For i = 0 To 3
        'フィルタ
        .Range("A1").CurrentRegion.AutoFilter Field:=8, Criteria1:=myKey(i)
 の時、例えば1がなかったりするとだめなんですよね？
 最初止まってしまったので、On Error Resume Next
 を入れてみたらうまくいきました。
 家でデータも少しいれただけなのでもういちど会社で確認したいと思います。
 ほんとうにありがとうございました。

 (夏目)さんのでもどこか変えればできますでしょうか？
 明日いろいろ見ながら挑戦したいと思います。
 (TTC)

 私も、わからなくなってしまったので、自分自身の勉強の為に、新規で質問してみました。
 今回は、お力になれなくて本当にごめんなさいねm(__)m
（夏目雅子似）

 いえいえ！こちらこそお付き合いいただいてありがとうございました。
 お力になれなくて・・・
 全然そんなことないです。すごい勉強になりました。
 1つの答えを出すのにもいろいろなやり方があるのですね！
 勉強のために夏目さんのコードでも試してみるつもりです。
 この作業が最初のステップなので、また分からなくなったら
 ぜひお願い致します。きっとまたすぐ質問します。
 いえ、絶対！
 (TTC)

 すでに解決済みとは思いますが、
 これで、どうでしょう？
（夏目雅子似）
 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 3 '←ありゃま、ここ「3」ですね(･･;)　だめだこりゃ(>_<)
        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がある間のループ」の始まり

        Set x = Nothing  '変数をクリアにする。

        Set x = Range("H2", Range("H65536").End(xlUp)).Find(What:="3", LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , MatchByte:=False)   'キャンセルNoの有無

        If x Is Nothing Then Exit Do   'キャンセルNo.3が無かったら、Loopを抜ける

        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 While Not x Is Nothing   '「キャンセルNo3がある間のループ」の終わり

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

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

 End Sub

  > For i = 0 To 3
 >        'フィルタ
 >       .Range("A1").CurrentRegion.AutoFilter Field:=8, Criteria1:=myKey(i)
 >の時、例えば1がなかったりするとだめなんですよね？
 > 最初止まってしまったので、On Error Resume Next
 > を入れてみたらうまくいきました。

 ここで i というのは、 0,1,2,3 とループで変化します。
 それによって何が変わるのかというと
 配列変数　myKey(i)　です。つまり、フィルターのキーワードです。
 この配列の値は、　　
 > myKey = Array("1", "2", "5", "9")
 で定義されています。 
 つまり、
 myKey(0) = 1 
 myKey(1) = 2 
 myKey(2) = 5 
 myKey(3) = 9 
 となっています。

 そして、
 >  .Range("A1").CurrentRegion.AutoFilter Field:=8, Criteria1:=myKey(i)
 でフィルタした後、↓で抽出された行を削除するのですが、

 >  .UsedRange.Offset(1).Select
 >       Selection.Resize(Selection.Rows.Count - 1, Selection.Columns.Count). _
 >       SpecialCells(xlCellTypeVisible).EntireRow.Delete Shift:=xlUp

 フィルタで抽出された件数が 0件　だとエラーが発生します。
 なので、H列に 1,2,5,9 があるのが前提でした。 
 抽出件数を取得して、If文で条件分岐すればよいのですが、
 >On Error Resume Next
 でも問題ありません。

   (INA)

 (INA)さんありがとうございました。
 会社でもうまくいきました。

 (夏目さん)どうもうまくいかないようです。
 まだじっくりは確認していないのですが・・・。
 ちょっと確認してみます。
 (TTC)

 夏目さんのコードで動作確認できました。

 但し、
 >AutoFilterMode = False
 などの記述で、対象となるオブジェクトを指定していないので、
 標準モジュールに記述すると、コンパイルエラーとなります。

 使用する Sheetモジュールに記述する必要があります。

  (INA)

 衝突しました。。

 INA様　フォローありがとうございます。m(__)m
 シートの件は、最初に

 ＞あっ、、シートに貼り付けてください。

 としていたのですが、

 それとは別に今回の私のコードが時々呼び出せない時がありますね。
 やはり、With ActiveSheet　と明記して標準モジュールに記述するべき
 なのかもしれませんね。それにしても、横着というか、基本が出来ていないん
 ですよね。我流でお恥ずかしいかぎりです。

 今回も最初に、INAさんが大筋を説明された時にすごく興味があったので
 参加させていただいたのですが、

 ＞ このとき配列変数もしくは、Dictionaryオブジェクトに格納する。
 そして取得した値をキーに、 オートフィルタ＆行削除を繰り返す。

 の方法がわからなっかので今回の様なコードになってしまいましたぁ、、
 途中で「3」の時の事を考えていたら、私の頭がループしてしまって汗。。。
 いい勉強をさせていただきました。ありがとうございました。m(__)m
 これからも、何卒、よろしくお願い申し上げます。
 でも、エクセルってむつかしいですね。
 だけど、おもしろいから、やめられない。。。。(･･;)
（夏目雅子似）

 To　TTC様へ
 少し気になってコードを見直したのですが、「3」を探すFindのところが
 思いっきり省略されていますので、↓の様に変更していただけないでしょうか？
Set x = Range("H2", Range("H65536").End(xlUp)).Find(What:="3", LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , MatchByte:=False)   'キャンセルNoの有無
 H列を選択して→編集→検索で「3」を指定します。
 これを記録しますと簡単にコードが入手できますので、今回の場合でしたら、
 After:と.Activate等を省略されて色々と試していただけないでしょうか？
 誠に無責任な回答、しかも、解決済みとは思いますが、出来ればで結構ですので
 一度試してみてください。
（夏目雅子似）

 夏目雅子似さんへ

 出来ました！！
 すいません。シートに貼り付けるとはそうゆう事だったのですね！
 シートと標準モジュールは違うんですね！
 シートに書き込めばシートを指定しなくてよいのですね・・・。
 基本的にはどちらが良いのでしょう？
 今回は別のファイルで作業させる指示なので
 標準モジュールの方でよいんですよね。
 とても勉強になりました。ありがとうございました。
 エクセルってすごいですね！

 あと、別のことなんですが、
　　nen = Format(Date, "yyyy")
    tuki = Format(Date, "mm")
    メッセージ = nen & " 年　" & tuki & "月度の集計を開始しますか？"
 というコードでMsgBoxに表示させたいのですが、
 年はちゃんと表示するのですが、月がうまくいきません。
 何か違う方法がありますでしょうか？

 これまた、思いっきり我流ですが、こんな感じで
 Sub 表示()

 Dim nen As Integer
 Dim tuki As Integer
 Dim Kotae As Integer

 nen = Format(Date, "yyyy")
 tuki = Format(Date, "mm")

 Kotae = MsgBox(nen & "年" & tuki & "月度の集計を開始しますか？", vbYesNo)
 If Kotae = 6 Then
    MsgBox "集計開始を開始します。"
    Else
    MsgBox "中止しました"
 End If

 End Sub

 MsgBoxで戻り値が必要な場合は（）でくくります。
 コードの中で値だけが確認したい時などはその必要はありません。

 シートのことは、ごめんなさいね。m(__)m
 私の方法は、どれも我流なので、真似されるなら、やはり
 INA様の様なコードの方がよろしいかと思います。
 ただ、こんな方法もあるという程度でお願いします。
（夏目雅子似）

 ありがとうございました。
 うまく表示させることが出来ました。

 今は勉強中なのでいろいろな方法をみて
 引き出しを増やしたいと思います。
 (TTC)

コメント返信：

[ 一覧(最新更新順) ]

[[20040627164919]] 『VBAで行を削除...』（TTC） ページの最後に飛ぶ

[[20040627164919]]　『VBAで行を削除...』（TTC）　ページの最後に飛ぶ