[[20190619140758]] 『シートのを選択しフィルター』(める) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『シートのを選択しフィルター』(める)

VBA初心者です。

シート名1から5までをフィルターかけていきたいです。
シート1しかフィルターがかかりません。

********************

ブック概要

シート名1から5とシート名 合計があります

*******************

コード
For i = 1 To 5

Sheets(i).Cells(1, 1).AutoFilter field:=4, Criteria1:="宮崎"

Next

********************

エラー

シート1しかフィルターがかかりません

初歩的なもので申し訳ありませんが教えてください。

< 使用 Excel:Excel2016、使用 OS:Windows10 >


コード記述間違えました。

dim i as long

For i = 1 To 5

Sheets(i).Cells(1, 1).AutoFilter field:=4, Criteria1:="宮崎"

Next
(める) 2019/06/19(水) 14:16


度々すいません。
やりたいことを整理しました。

加工というファイルを開いて、そのブックにあるシート名1から5(別途シート合計あり)を
フィルターかけます。
それをコピーしてマクロが記述されているブックのシート合計に貼り付けます。

Dim i As Long

Workbooks.Open ThisWorkbook.Path & "\加工"

    For i = 1 To 5

        Sheets(i).Cells(1, 1).AutoFilter field:=4, Criteria1:="宮崎"
        Cells(1, 1).currengtregion.Offset(1, 0).Copy _
        ThisWorkbook.Sheets("合計").Cells(Rows.Count, 1).End(xlUp).Row.Offset(1, 0)

    Next

End Sub

エラーはRangeクラスのAutoFilterメソッドが失敗しましたとでます。
(める) 2019/06/19(水) 14:31


 多分ねシート名を半角数字だけにしているからだと思います。
 何も考えないで、こういうことしている人が多いみたいですけど。

 Sheets(i)

 これだと、シートのインデックスと処理しているんじゃないかと。
 1番左のシートのみフィルタがかかって、2番目から5番目のシートのCells(1, 1)には何も書かれたないとか、表になって無いんじゃ・・・・。

 ダメもとで、Sheets(Cstr(i)) かな?

 追加の分ちろっと
 .currengtregion
 スペルが違います。

 range("A1").

 と打つと候補が出るから、そこから選ぶとスペルの間違いは減ると思います。
 これをコピーして使う。

 >End(xlUp).Row.Offset(1, 0)
             ↑
           .Row はいらないんじゃ。
(BJ) 2019/06/19(水) 14:38

 もしくは、数式のデータが多くておっつかない???
 再計算を手動にして、フィルタの後に Doevents を入れてみるとか。
(BJ) 2019/06/19(水) 14:43

BJ様

ありがとうございます。
Sheets(Cstr(i))にしてみましたがうまくいきませんでした。

マスタを作成しましたが、今度は違うところでエラーがでました。

Sub フィルター()

Dim i As Long
Dim Sname As String

Workbooks.Open ThisWorkbook.Path & "\加工"

With ActiveWorkbook

    For i = 1 To 3
    Sname = ThisWorkbook.Sheets("マスタ").Cells(i, 1)
        .Sheets(Sname).Range("A1").AutoFilter field:=4, Criteria1:="宮崎"
        .Cells(1, 1).CurrentRegion.Offset(1, 0).Copy _   ←ここでデバックがでます。
        ThisWorkbook.Sheets("合計").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

    Next
End With

End Sub

よろしくお願いします。

(める) 2019/06/19(水) 17:41


 すみません。

 >Cells(1, 1).CurrentRegion.Offset(1, 0).Copy _   ←ここでデバックがでます。
 >       ThisWorkbook.Sheets("合計").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

 ここだけやってみたらエラーにならなかった。

 .Sheets(Sname).Cells(1, 1).

  ^^^^^^^^^^^^^^^
    ↑
   これが抜けているのでは?
(BJ) 2019/06/19(水) 18:07

横からですけど、オブジェクトを省略して、アクティブになっているはずのブックやシートを対象にするんじゃなくて、ちゃんと対象のオブジェクトを記述するようにすれば間違いに気づけそうな気がします。

テストしてませんがこんな感じではないでしょうか?(コンパイルは通りました)

    Sub フィルター_改()
        Dim i As Long
        Dim dstRNG As Range

        With ThisWorkbook.Sheets("合計")
            Set dstRNG = .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
        End With

        With Workbooks.Open(ThisWorkbook.Path & "\加工.xlsx")
            For i = 1 To 5

                '▼オートフィルタで抽出してコピペ
                With .Sheets(i)
                    .AutoFilterMode = False
                    .Range("A1").AutoFilter field:=4, Criteria1:="宮崎"
                    .AutoFilter.Range.Copy dstRNG
                End With

                '▼出力先の【セル】を再設定
                With ThisWorkbook.Sheets("合計")
                    Set dstRNG = .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
                End With
            Next

            '▼加工.xlsxを保存せずに閉じる
            Application.DisplayAlerts = False
            .Close
            Application.DisplayAlerts = True
        End With

    End Sub

(もこな2) 2019/06/19(水) 18:40


BJ様
もこな2様

ありがとうございます。
上手くいきました。

(める) 2019/06/19(水) 19:24


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.