[[20150111015327]]　『オートフィルタ内にデータがない場合の無限ループ』（まさ）　ページの最後に飛ぶ

『オートフィルタ内にデータがない場合の無限ループを回避する方法』（まさ）

いつもお世話になっております。

下記マクロは
AW64:AW78に関数でデータを読込
参照データが有ればその値を表示
参照データが無ければ空白になるようにしております。

そして、オートフィルタで、データの有無に関わらず、<>で空白以外を絞り込みして
ループ作業を行っております。

ここで質問です。
　↓
ただ、データがない場合は、無限ループ防止の為にこのマクロで
空白時は処理を終了するようにしているつもりなのですが、実行されてしまいます。

If WorksheetFunction.CountA(Range("aw64:aw78")) <> 0 Then
End If

記述にオカシイところがあるのでは？と思うのですが、分からずじまいで困っている状況です。
みなさま、どうかアドバイスをよろしくお願いします。

（現在のマクロ）

       Dim d      As Variant 
       Dim i      As Long

            'オートフィルタ解除し再セット
            Range("av63:aw63").AutoFilter
　　　　　　'空白以外を絞込
            Range("av63:aw63").AutoFilter Field:=2, Criteria1:="<>", Operator:=xlAnd

        '指定範囲にデータがない場合終了
        If WorksheetFunction.CountA(Range("aw64:aw78")) <> 0 Then

                '★処理１：作業セルの残骸を削除
                Range("y61,y63").Value = ""

　　　　　　　　'前シートのデータをこのシートの表内に貼り付け

                Range("y63").Value = ActiveSheet.Previous.Range("a50").Value

                'リストのセルAW64からデータのある最終行を取得
                d = Range("aw64").End(xlDown).Row
　　　　　　
            For i = 64 To d 'リスト64行目からデータのある最終行までを処理

                '★処理２：作業セルにリストのデータ転記
                Range("y61").Value = Range("aw" & i).Value

                '★処理３：作業セル間でデータのやりとり
                Range("y63").Value = Range("y62").Value

            Next i

                '★処理４：作業セルにある確定データを表内に貼り付け
                Range("a50").Value = Range("y62").Value

　　　'指定範囲にデータがない場合は終了

      End If

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

 CountA は非表示になっているセルも相手にします。
 （というか、ほとんどの関数は、非表示行も相手にします）
 抽出行の有無の判定は、関数を使うならSUBTOTAL　が簡単です。

 もう１つ、オートフィルターのリストは今後増えるかもしれませんね。
 最後の行をaw78といった固定セルで記述するのはやめましょう。

 抽出がある状態、あるいは、ない状態で、以下のマクロを走らせてみてください。
 タイトル行を除いた、表示されている行数を知らせます。

 Sub ヒント()
    MsgBox WorksheetFunction.Subtotal(103, ActiveSheet.AutoFilter.Range.Columns(1)) - 1
 End Sub
（β） 2015/01/11(日) 05:09

抽出有無は上記コメントを参考にしてもらうとして
そのほかのコードも具合悪いですね。
ループで取り出して、同じセルに転記しているところも？？ですが
なにより、このコードでは、非表示の行の値も取り出してしまいます。

当該行が表示されていいるかどうかの判定を行うか、あるいは
オートフィルター領域を別の場所にコピペ（表示行だけがコピペされる）して
そちらを元ネタにして扱うか、いずれかが必要。

今、出先で、詳しくはコメントしきれず
どなたかからの回答をお待ちください。
（β） 2015/01/11(日) 10:48

βさん

早朝からのアドバイスありがとうございます。

ヒントを参考に下記のようにしてみました。
一応、無限ループは無くなったように思われます。

・あと、"bc63:bc78"の部分ですが、この範囲には、表からデータを参照しているため、これ以上データが増えることはないため、絞り込んだほうが少し早くなるかな？と最終行を指定しています。

・ループで取り出して、同じセルに転記しているところについては
　表の１つのセルに（いぬ、ねずみ、うし、とら、・・・）とあるデータが
　"bc63:bc78"内にあれば、削除していいくという作業のために、関数とマクロを併用し処理していますが、その説明は下記です。

Y61：検索値
Y62：Y63の値を関数で参照しY61の検索値に該当する値を削除させる
　↓
'データ検索置き換え用マクロ関数

 Function myReplace(ByVal txt As String, ByVal myStr As String) As String
    With CreateObject("VBScript.RegExp")
        .Pattern = "\[[^\]]*" & myStr & "[^\]]*\]"
        myReplace = .Replace(txt, "")
    End With
End Function

Y63：Y62の値を転記する場所

処理概要

Y63に表のセル値を転記→A"bc63:bc78"内に値があれば→BY61転記→CY62の関数で該当値を削除→DY62の値をY63に転記・・・・

あとは、"bc63:bc78"内のリストをループごとに上記を繰り返し、表のセル値から該当する値が無くなるまで繰り返す。です。

色々、おかしな点があると思いますが、ご確認お願いします。

    Dim sor As Long
    Dim d      As Variant '
    Dim i      As Long    'ループで使用する変数

    Range("bb63:bc63").AutoFilter 'オートフィルタ解除

    Range("BB63").AutoFilter Field:=2, Criteria1:="<>" 'オートフィルタセット

        'Subtotal関数：データ個数をカウントする因数103(非表示の値は無視)
        sor = WorksheetFunction.Subtotal(103, Range("bc63:bc78"))

        If sor = 1 Then '処理終了
            MsgBox " データなし"

        Else 'データあれば処理
            MsgBox sor - 1 & " 件処理します"

            For i = 64 To d 'リスト64行目からデータのある最終行までを処理

                '★処理２：作業セルにリストのデータ転記
                Range("y61").Value = Range("aw" & i).Value
                '★処理３：作業セル間でデータのやりとり
                Range("y63").Value = Range("y62").Value

            Next i
                '★処理４：作業セルにある確定データを表内に貼り付け
                Range("a50").Value = Range("y62").Value
       End If
（まさ） 2015/01/11(日) 13:27

文字化けしたので再度

（１）Y63に表のセル値を転記→（２）"bc63:bc78"内に値があれば→（３）Y61転記→（４）Y62の関数で該当値を削除→（５）Y62の値をY63に転記・・・・
（まさ） 2015/01/11(日) 13:30

 ＞色々、おかしな点があると思いますが、ご確認お願いします。 
 それより先に、見直し後のプログラムでどんな結果が得られたのかご説明ください。
 取りあえずうまく行っているとか、結果が○○になるべきが××になってしまう、とか。

 ＞・あと、"bc63:bc78"の部分ですが、この範囲には、表からデータを参照しているため、
 ＞これ以上データが増えることはないため、絞り込んだほうが少し早くなるかな？と最終行を指定しています。

 と云うことは、たった15セルの決め打ちプログラムですよね。

 でしたら、わざわざオートフィルタに掛けるまでもなく
 全部セルを処理対象に処理しても大差ないと思いますよ。

 なので変数「d」も78の決め打ちでいいです。

 そうは言っても、データの有無は先に出したいと云うことなら、
 フィルタなしで、以下の計算で出せます。
 sor　=15-WorksheetFunction.COUNTBLANK(range("BC64:BC78"))

 ところで、まささんのプログラムでは、とにかく全セルチェックすることになっているんですが、
 このセル値が空白かどうかチェック入れていますか？
 　↓
 Range("aw" & i).Value

（半平太） 2015/01/11(日) 16:01

半平太さん

ありがとうございます。

先ほどのコードで、目的の結果は得られておりますので、使用する分には特に問題はありません。
ただ、ご指摘通り、bc64:bc78の範囲でフィルタについては、処理の度にシートにアクセスするので避けたいと思いました。

そこで、アドバイスを念頭にして

１．フィルタ操作を廃止
２．「i」の値がなければ処理をスルーする

上記２点を下記の通り作りました。

※作業シートでテストの都合上、セル範囲は、投稿当初と異なります。

結果は、目的の通り動作しています＆高速化した感じがします。

Sub 改善2()

    Dim sor As Long
    Dim d      As Variant
    Dim i      As Long

        sor = 15 - WorksheetFunction.CountBlank(Range("bc64:bc78"))

        If sor = 0 Then '処理終了
            MsgBox " データなし"
        Else 'データあれば処理
            MsgBox "該当者を" & sor & " 件削除します"

                Range("y61,y63").Value = "" '作業セル削除
                Range("y63").Value = ActiveSheet.Previous.Range("q50").Value '前日分転記

            For i = 64 To 78 '64行～78行目まで処理

              If Range("bc" & i).Value = Empty Then 'セルが空白なら無視、値があれば処理
              Else '値あり
                Range("y61").Value = Range("bc" & i).Value '転記１：リストの値を作業セルへ転記
                Range("y63").Value = Range("y62").Value '転記２
              End If

            Next i
                Range("q50").Value = Range("y62").Value '結果を転記
        End If
End Sub
（まさ） 2015/01/11(日) 18:21

皆さんのお力で解決できました。

ありがとうございます(^^ゞ
（まさ） 2015/01/12(月) 10:04

コメント返信：

[ 一覧(最新更新順) ]

[[20150111015327]] 『オートフィルタ内にデータがない場合の無限ループ』（まさ） ページの最後に飛ぶ

[[20150111015327]]　『オートフィルタ内にデータがない場合の無限ループ』（まさ）　ページの最後に飛ぶ