『オートフィルターをループしたい』(AF)
お世話になっております。
AFと申します。
表題の通り、現在オートフィルターの切り替えをループするボタンを作成しております。
参考にしたページは
https://www.excel.studio-kazu.jp/kw/20220330140218.html
作成した(99%コピペですが・・・)マクロは
Option Explicit
Sub オートフィルタ切り替えループ()
Dim r As Range
Static i As Long
With Worksheets("見積依頼")
Set r = .Cells(8, 4).CurrentRegion 'D列8行目にフィルタ If Not .AutoFilterMode Then i = 2 r.AutoFilter 4, r(i, 4) Else i = i + 1 r.AutoFilter 4, r(i, 4) If i > r.Rows.Count Then r.AutoFilter End If End With
If i = Sheet2.Cells(7, 14) + 1 Then 'N列7行目にD列のデータ数を数える関数
'関数 =SUMPRODUCT((D9:D158<>"")/COUNTIF(D9:D158,D9:D158&""))
i = 1
Sheet2.Range("D8").AutoFilter 4, "<>"
End If
End Sub
VBE画面でSheet2(見積依頼)となっております。
D列に
1-5
2-5
3-5
4-5
5-5
というデータがあるとき
上記マクロを実行すると5-5が表示されません。
1-5、2-5、3-5、4-5、空白を除外という順で表示されてしまいます。
1-5、2-5、3-5、4-5、5-5、空白を除外、1-5、2-5、以下繰り返し
となるようにするにはどうすればよいのでしょうか。
お手数ですがよろしくお願いします。
< 使用 Excel:Excel2019、使用 OS:Windows10 >
>Static i As Long
> i = i + 1
これか! これはループと言えるのか…ま、いいけど。
>D列に
>1-5
>2-5
>3-5
>4-5
>5-5
>というデータがあるとき
D 列の何行目にあるのですか?? 想像はつくけど列だけ書いて行を書かないって、絶対だめでしょ。
(xlg) 2023/09/27(水) 15:54:18
このような表になっております。
Option Explicit
Sub オートフィルタ切り替えループ()
Dim r As Range
'Static i As Long
Dim i As Long
Dim CountData As Long
With Worksheets("見積依頼")
Set r = .Cells(8, 4).CurrentRegion
CountData = Sheet2.Cells(7, 14)
For i = 1 To CountData + 1
r.AutoFilter 4, r(i, 4)
Next
Sheet2.Range("D8").AutoFilter 4, "<>"
End With
End Sub
あれから色々やってみたのですが、上記マクロが精一杯でした。
F8で実行するとやりたい動きになるのですが、ボタンに登録すると(当たり前ですが)一瞬で終わってしまいます。
参考にしたページ
https://excel-ubara.com/excelvba4/EXCEL281.html
(AF) 2023/09/27(水) 16:20:03
■1
↓は、やってることとコメントが一致していません
Set r = .Cells(8, 4).CurrentRegion 'D列8行目にフィルタ
さらに言うと、【r】に格納されるのは【D8セルが"含まれる"表範囲】であって【D列8行目以下のセル範囲】ではありません。
■2
>D列に〜というデータがあるとき
提示のような並びであればそれなりに幸せな結果になると思いますが、D列(の初めのほうに)重複があれば↓は破綻しませんか?
r.AutoFilter 4, r(i, 4)
■3
>オートフィルターの切り替えをループする
↑の意味が、【実行する(ボタンを押す)】たびに【抽出条件】を【一定のパターン】の範囲で変わるようにしたいという話ならば以下のように考えてみてはどうでしょうか?
1. オートフィルタ自体は手動で設定 2. 【別シート】のA列にリストを用意しておく(データをコピペして重複の削除をすればok) 3. 以下のマクロを研究して、適宜カスタマイズ Sub さんぷる() Stop 'ブレークポイントの代わり Static i As Long Dim 順番 As Long Dim 抽出条件 As String
i = i + 1 With Worksheets("別シート") 順番 = i Mod (.Cells(Rows.Count, "A").End(xlUp).Row + 1)
If 順番 = 0 Then 抽出条件 = "<>" Else 抽出条件 = .Cells(順番, "A").Value End If End With
Debug.Print i & "回目の実行です" & vbLf & "リスト" & 順番 & "番目の条件は【" & 抽出条件 & "】です" & vbLf 'ここにオートフィルタで抽出する命令を記述 End Sub
なお、オートフィルタが設定されている範囲は↓で取得できます。
【ワークシートオブジェクト】.Autofilter.Range
(もこな2 ) 2023/09/27(水) 18:35:39
Sub test() Dim a As Object Dim ws As Worksheet, r As Range Dim k As Long, s As String Static i As Long
Set a = CreateObject("system.collections.arraylist") Set ws = Sheets("Sheet1") ws.AutoFilterMode = False Set r = ws.Range("D8", ws.Cells(Rows.Count, 4).End(xlUp))
a.Add "<>" For k = 2 To r.Count s = r(k).Value If Not a.contains(s) Then a.Add s Next
i = i + 1 If i = a.Count Then i = 0
r.AutoFilter 1, a(i)
End Sub
(マナ) 2023/09/27(水) 19:21:31
もこな2さん
マクロありがとうございます。
ステップインで動作の確認、学習を進めていきます。
マナさん
マクロありがとうございます。
やりたいことができました。
(AF) 2023/09/28(木) 12:00:41
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.