質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

Q&A

解決済

4回答

1971閲覧

マクロを使ってフィルターを使用したいのですが、回数が多くて困っています。

sugerShogo

総合スコア18

マクロ

定義された処理手続きに応じて、どのような一連の処理を行うのかを特定させるルールをマクロと呼びます。

0グッド

0クリップ

投稿2016/06/15 03:58

編集2016/06/15 04:41

###前提・実現したいこと

イメージ説明

マクロを使ってフィルターを使いたいのですが、72回分のマクロの対策に困っています。(写真は3人分ですがこれが72人分まで続いています)

※6人後にで1列のスペースをあけて区切ってあります。
6人スペース6人スペース6人スペース.....みたいな感じです

###該当のソースコード

Sheets("統合").Columns("A:S").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("C78:D79"), CopyToRange:=Range("A88:B88"), Unique:= _ False Sheets("統合").Columns("A:S").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("E78:E79"), CopyToRange:=Range("C88:F88"), Unique:= _ False Sheets("統合").Columns("A:S").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("i78:j79"), CopyToRange:=Range("g88:h88"), Unique:= _ False Sheets("統合").Columns("A:S").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("k78:k79"), CopyToRange:=Range("i88:l88"), Unique:= _ False これが2回分なのであと70回も繰り返すのが大変で、、、

###補足情報(言語/FW/ツール等のバージョンなど)
excel 2010を使っています。
データは別シートから拾ってきます。

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答4

0

Rangeを数値で指定する方法は他の方も提示されている通りです。
あとは6人毎に1列ずらすという部分を紹介します。

Dim i as Integer Dim iCol as Integer iCol = 0 For i = 1 to 72 '6人毎に1列ずらす調整 If (i Mod 6) = 1 Then '6で割った余りが1の場合 iCol = iCol + 1 End If Sheets("統合").Columns("A:S").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range(cells(78, iCol + 2), cells(79, iCol + 3)), CopyToRange:=Range(cells(88, iCol), cells(88, iCol + 1)), Unique:= _ False Sheets("統合").Columns("A:S").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range(cells(78, iCol + 4), cells(79, iCol + 4)), CopyToRange:=Range(cells(88, iCol + 2), cells(88, iCol + 5)), Unique:= _ False iCol = iCol + 6 Next

6回に1回だけ処理される中で1列ずらしてあげています。
それとは別に、1里終わったら列を6列ずらしています。

こんなかんじでどうでしょうか?

投稿2016/06/15 06:23

jawa

総合スコア3013

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

0

ベストアンサー

ループで回したらいいいんじゃないですか。
Rangeのところはこう書くこともできます。

VBA

1Range(Cells(開始行,開始列),Cells(終了行,終了列))

なのでこんな感じとか(適当なので間違ってたらすみません)

VBA

1For i = 1 To 72 2 c = i * 6 3 Sheets("統合").Columns("A:S").AdvancedFilter Action:=xlFilterCopy, _ 4 CriteriaRange:=Range(Cells(78, c + 2), Cells(79, c + 3)), CopyToRange:=Range(Cells(88, c), Cells(88, c + 1)), Unique:= _ 5 False 6 Sheets("統合").Columns("A:S").AdvancedFilter Action:=xlFilterCopy, _ 7 CriteriaRange:=Range(Cells(78, c + 4), Cells(79, c + 4)), CopyToRange:=Range(Cells(88, c + 2), Cells(88, c + 5)), Unique:= _ 8 False 9Next

訂正

VBA

1Dim i As Long 2Dim c As Long 3For i = 1 To 72 4 c = (i - 1) * 6 + 1 + Application.WorksheetFunction.ROUNDDOWN((i - 1) / 6, 0) 5 Sheets("統合").Columns("A:S").AdvancedFilter Action:=xlFilterCopy, _ 6 CriteriaRange:=Range(Cells(78, c + 2), Cells(79, c + 3)), CopyToRange:=Range(Cells(88, c), Cells(88, c + 1)), Unique:= _ 7 False 8 Sheets("統合").Columns("A:S").AdvancedFilter Action:=xlFilterCopy, _ 9 CriteriaRange:=Range(Cells(78, c + 4), Cells(79, c + 4)), CopyToRange:=Range(Cells(88, c + 2), Cells(88, c + 5)), Unique:= _ 10 False 11Next

投稿2016/06/15 04:43

編集2016/06/15 06:14
ttyp03

総合スコア16996

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

sugerShogo

2016/06/15 05:03

ご回答ありがとうございます。 変数が定義されていませんというエラーが出るのですが、なぜでしょうか?
ttyp03

2016/06/15 05:06

変数くらいはご自分で用意してくれるかと思って書きませんでした。 Dim i As Long Dim c As Long この2つをループの前に追加してください。
sugerShogo

2016/06/15 05:18

すみません、マクロは記憶マクロしか使えないので、、、 実行してみたら人は変わっているのに同じデータが繰り替えされました、、、 自分でも改善してみますが、もしよろしければもう一度見直していただけないでしょうか?すみません。
ttyp03

2016/06/15 05:44

少し訂正しましたのでコードを追加しました。
sugerShogo

2016/06/15 05:59

完璧にできました!!! ありがとうございます! 自分なりに数字を変えたりマイナスにしてみたりしたのですが、全然ダメでした(笑) 6人分のデータの後に1行スペースがあるのでどうしてもそこで止まってしまうのですがこれへの対策ってできますでしょうか?
ttyp03

2016/06/15 06:05

1行?1列ってことですかね。 ループの最初の、 c = (i - 1) * 6 + 1 でひとり分の開始列を計算しているので、そこをなんとかすればいけると思いますが。 少し考えます。
sugerShogo

2016/06/15 06:10

列でした、すみません。
ttyp03

2016/06/15 06:15

修正してみました。
sugerShogo

2016/06/15 06:23

本当に完璧にできました! ttyp03さんのことほんと尊敬します。 いつか自分でできるようになってみたいです。
ttyp03

2016/06/15 06:28

なんとか無事に出来てよかったです。 記録したマクロをいじっていくことからはじめれば、そこそこ使えるようになりますよ。
guest

0

こんな感じでFor文で繰り返せば72回記述する必要はないと思います。
動かしていないんで保証はできませんが、、、。

Dim i as Long For i = 1 to 72 Sheets("統合").Columns("A:S").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range(Cells(i+2,78),Cells(i+2,79)), CopyToRange:=Range(Cells(6(i-1)+1,88),Cells(6(i-1)+1,88)), Unique:= _ False Sheets("統合").Columns("A:S").AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range(Cells(6(i-1)+5,78),Cells(6(i-1)+5,79)), CopyToRange:=Range(Cells(6(i-1)+3,88),Cells(6(i-1)+3,88)), Unique:= _ False Next i

投稿2016/06/15 04:41

tomo.ina

総合スコア357

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

sugerShogo

2016/06/15 04:54

ご回答ありがとうございます。 (Cells(6(i-1)+1,88),Cells(6(i-1)+1,88))の部分で、エラーが発生するのですが何が原因でしょうか?
guest

0

マクロで全てをやるのは量的にちょっとムリがあるかと思います。
そこまで書けているのなら、固定カラム指定ではなく変数などにしてループすればいいとは思いますが・・・。

データの位置が固定されているならば、こんな感じでフィルターをする前にデータを一覧化してはどうでしょう?
一覧

投稿2016/06/15 04:32

kaputaros

総合スコア1844

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

sugerShogo

2016/06/15 04:44

記憶マクロで作成したので、自分で書いてはいないんです、、、 マクロを見たら、ここはこうかな?って理解できるほどなので、、、 データの位置は固定されているのですが、別シートから引っ張ってこないといけないもので、、、
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問