[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『フィルタオプションの繰り返しを簡略化』（taiyo）
フィルタオプションを31回繰り返すマクロをマクロの記録を利用して作成しましたが、 時間がかかります。 まとめて早くする方法は有りますか？ 宜しくお願い致します。
Sub Macro1()
'1日
Range("B3:AK1000").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Range("AM2:AM3"), CopyToRange:=Range("AM5"), Unique:=False
'2日
Range("B3:AK1000").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Range("AN2:AN3"), CopyToRange:=Range("AN5"), Unique:=False
・
・
・
'30日
Range("B3:AK1000").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Range("BP2:BP3"), CopyToRange:=Range("BP5"), Unique:=False
'31日
Range("B3:AK1000").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Range("BQ2:BQ3"), CopyToRange:=Range("BQ5"), Unique:=False
End Sub
[エクセルのバージョン]Excel2000 [OSのバージョン]WindowsXP
Sub Macro1()
Application.Calculation = xlCalculationManual'★
With Range("B3:AK1000")
'1日
.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Range("AM2:AM3"), CopyToRange:=Range("AM5"), Unique:=False
'2日
.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Range("AN2:AN3"), CopyToRange:=Range("AN5"), Unique:=False
・
・
・
'30日
.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Range("BP2:BP3"), CopyToRange:=Range("BP5"), Unique:=False
'31日
.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Range("BQ2:BQ3"), CopyToRange:=Range("BQ5"), Unique:=False
End With
Application.Calculation = xlCalculationAutomatic'★
End Sub
とすると、多少は違いが出るかもしれません。
多分、主要なところ（AdvancedFilter）で時間がかかっていると思えます。
フィルタ実行時に必ず再計算されるので、31回フィルタリングすると、31
回再計算します。
フィルタ中は手動再計算にして、実行後に自動再計算に戻すことで、再計算
回数が１回になり、その分時間短縮されるはずです。
(みやほりん)(-_∂)b
なんとなく・・・ですが、↓と同じことをマクロでやろうとされているのではないですか? [[20090810161427]]『チェックが付いているところを日付別に表示』 そうであれば、フィルタオプションを31回も使うのに違和感を持ちました。 配列のループでも可能であり、こちらで試すとたいして時間がかかるようには感じませんでしたが・・・ こんな感じです。 違うかなぁ・・・(^^ゞ (Hatch) Sub test() Dim x, y Dim i As Long, j As Long, cnt As Long x = Range("B1:AK1000").Value ReDim y(1 To 1000, 1 To 36) For i = 2 To 36 cnt = 0 For j = 4 To 1000 If x(j, i) = "○" Then cnt = cnt + 1 y(cnt, i - 1) = x(j, 1) End If Next j Next i Range("AM5:BU5").Value = Range("C3:AK3").Value Range("AM6").Resize(UBound(y), UBound(y, 2)).Value = y End Sub
みやほりんさん 半分くらいの時間でできるようになりました。 有難う御座います。
Hatchさん 一瞬でできるようになったのですが、私の最初の質問の仕方が悪かったですね。 元の表は、下記のようにB〜Eに区分等が入ってる為、結果の表が少しずれてしまいます。 マクロ初心者のため訂正の仕方がわかりませんので、教えていただきたいです。
《元の表》 A B C D E F G H I・・・ 1 タイトル 2 3 NO. ﾕｰｻﾞｰ名 区分 商品 売上日 住所 1日 2日 3日・・・ 4 日 月 火・・・ 5 1 A社 ○ 6 2 B社 ○ 7 3 C社 ○
《結果の表》 AM AN AO AP AQ AR 1 2 3 4 51日 2日 3日 4日 5日 6日 7日 6 A社 7 B社 8 C社 9 このようにずれてしまいます。A社をAM6に表示させるにはどこを訂正したら良いでしょうか？ 宜しくお願い致します。
(taiyo）
コードを一部修正。データ範囲と配列xを同じにしています。
コメントを入れてみますので、どのようなことをやっているのか分かりますか? (Hatch)
Sub test()
Dim x, y
Dim i As Long, j As Long, cnt As Long
x = Range("A1:AK1000").Value '基になるデータを配列xに読み込む
ReDim y(1 To 1000, 1 To 36) 'xと同じ程度の配列yを準備する
For i = 2 To 36 '○を調べる列を順次見ていく。G列からならFor i = 5 To 36 のような感じ
cnt = 0 '列単位でカウントを0に戻す
For j = 4 To 1000 'データの行順に○を調べる。5行目からならFor j = 5 To 1000のような感じ
If x(j, i) = "○" Then
cnt = cnt + 1
y(cnt, i - 1) = x(j, 2) 'y(1,1)から該当データを入れたいので、y(cnt, i - 4) = のようにiの開始値が5ならi-4として1になるようにする
End If
Next j
Next i
Range("AM5:BU5").Value = Range("C3:AK3").Value '列見出しをコピーしているだけなので適切な範囲に修正。= Range("G3:AK3").Value のような感じ
Range("AM6").Resize(UBound(y), UBound(y, 2)).Value = y
End Sub
こんな感じかな？
Sub test3()
Dim x, y
Dim i As Long, j As Long, cnt As Long
x = Range("A1:AK1000").Value
ReDim y(1 To UBound(x, 1), 1 To UBound(x, 2))
For i = 5 To UBound(x, 2)
cnt = 0
For j = 5 To UBound(x, 1)
If x(j, i) = "○" Then
cnt = cnt + 1
y(cnt, i - 6) = x(j, 2)
End If
Next j
Next i
Range("AM5:BU5").Value = Range("G3:AK3").Value
Range("AM6").Resize(UBound(y, 1), UBound(y, 2)).Value = y
End Sub
(とおりすがり)
Hatchさん
説明を入れていただいたおかげで、できました。 ホントに親切に有難う御座いました。 中身を理解できたので、勉強にもなりました。 ありがとうございます。
とおりすがりさん とおりすがりさんのでもできました。 いろいろやり方が有るんですね。 有難う御座いました。
（taiyo）
○が入力されていたら抽出としていたんですが、空白以外だったら抽出としたくて、もう一度質問しました。
If x(j, i) = "○" Thenの部分をIf x(j, i)= Value <> "" Thenに変えてみたんですが すべて抽出されてしまいました。 宜しくお願い致します。
Sub test()
Dim x, y
Dim i As Long, j As Long, cnt As Long
x = Range("A1:AK1000").Value '基になるデータを配列xに読み込む
ReDim y(1 To 1000, 1 To 36) 'xと同じ程度の配列yを準備する
For i = 2 To 36 '○を調べる列を順次見ていく。G列からならFor i = 5 To 36 のような感じ
cnt = 0 '列単位でカウントを0に戻す
For j = 4 To 1000 'データの行順に○を調べる。5行目からならFor j = 5 To 1000のような感じ
If x(j, i) = "○" Then
cnt = cnt + 1
y(cnt, i - 1) = x(j, 2) 'y(1,1)から該当データを入れたいので、y(cnt, i - 4) = のようにiの開始値が5ならi-4として1になるようにする
End If
Next j
Next i
Range("AM5:BU5").Value = Range("C3:AK3").Value '列見出しをコピーしているだけなので適切な範囲に修正。= Range("G3:AK3").Value のような感じ
Range("AM6").Resize(UBound(y), UBound(y, 2)).Value = y
End Sub
(taiyo)
空欄だと思って居られるセルが 実は空欄じゃない可能性が高いと思います。
空欄だと思っているセルに 実際は何が入っているか（スペースかな？） 確認してみられてはどうでしょう。
例えば LEN関数で調べたら？ TYPE関数で調べたら？
また 該当範囲は 手入力ですか？ それとも、どこかからデータをコピペ？ 或いは、数式で？
(HANA)
ということは、If x(j, i)= Value <> "" Thenであっているんでしょうか？
LEN関数ではどのように調べるんでしょうか？
TYPE関数では、「1」と表示されます。ということは、数値が入っていると言うことなんでしょうか？ 「Delete」したり「数式と値のクリア」をしてみて何も入ってないように思えるのですが・・・。
該当範囲は手入力で、○ではなくてA、B、C・・・といれることにして、 入力されていれば抽出したいんです。
よろしくお願いします。
(taiyo)
済みません、勘違いしてました。
何も入力されていない時 ＞If x(j, i)= Value <> "" Then は良いのですが、たぶん 確認していると思って居られるセルと 実際にエクセルが調査しているセルの間で ズレが生じて居るのではないでしょうか。
実際にやってみられたコードを載せてみて下さい。 上のコードは(Hatch)さんのコードをコピペした物ですよね？
(HANA)
> ＞If x(j, i)= Value <> "" Then > は良いのですが、たぶん If x(j, i) <> "" Then とすべきでは? (Hatch)
あ・・・済みません 本当ですね。 ＞If x(j, i) <> "" Then これですね。
(HANA)
前のコードをとおりすがりさん風に直すと以下のような感じです。(Hatch)
Sub test4()
Dim x, y
Dim i As Long, j As Long
Dim cntC As Long, cntR As Long
x = Range("A1:AK1000").Value
ReDim y(1 To UBound(x), 1 To UBound(x, 2))
For i = 7 To UBound(x, 2)
cntC = cntC + 1
cntR = 0
For j = 5 To UBound(x)
If x(j, i) <> "" Then
cntR = cntR + 1
y(cntR, cntC) = x(j, 2)
End If
Next j
Next i
Range("AM5:BQ5").Value = Range("G3:AK3").Value
Range("AM6").Resize(UBound(y), UBound(y, 2)).Value = y
End Sub
If x(j, i) <> "" Then としたらできました。
ありがとうございました。
『If x(j, i) <> "" Then』 と 『If x(j, i)= Value <> "" Then』はどのように違うのでしょうか？
今後のためにも、教えていただけたらうれしいです。 宜しくお願い致します。
(taiyo)
If x(j, i)= Value <> "" Then は構文として成立していませんよ。 (ROUGE)
そうなんですね。 ありがとうございました。 (taiyo)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.