エクセルマクロの構文を短くしたい

質問

１週間分のデータの集計をします。
オートフィルターをかけ曜日で絞りかつ商品毎（15アイテム位）で絞り抽出されたデータを項目毎（４項目位）に別シートへはりつけます。
オートフィルター→月曜日抽出→A商品抽出→A商品のあ項目コピー→別シートの該当セルへペースト→A商品い項目コピー→別シートの該当セルへペースト・・・と続けA商品が終わったらオートフィルター→B商品抽出→B商品のあ項目コピー→・・・延々と15商品抽出・コピー・ペーストとつづけます。月曜日がおわれば次に火曜日抽出し同じ事をくりかえします。
何とか簡単な構文にならないでしょうか？

回答No.7

xls88 · ベストアンサー

＞回答番号：No.6 この回答への補足
ダメ出しの件は返事をいただけずスルーされたので、問題なしと理解します。

コードの方は、こんな風な感じになるのでは？と思います。
変数weeklistとcmdilistの元データをどこから取得するかですが
取りあえず、weeklistはArrayして、cmdilistは集計シート検査シートから取るようにしてあります。
詳細がよくわからないので、実状に合わせて書き換えてください。

Sub Test1()
　　Dim weeklist As Variant
　　Dim cmdilist As Range
　　Dim i As Integer
　　Dim j As Integer
　　Dim k As Long

　　weeklist = Array("月", "火", "水", "木", "金", "土")
　　Set cmdilist = Sheets("集計シート検査").Range("C2:R2")

　　With Sheets("検査実績貼り付け").Range("A2:H2")
　　　　For i = 0 To 5
　　　　　　.AutoFilter Field:=8, Criteria1:=weeklist(i)
　　　　　　For j = 1 To 16
　　　　　　　　'MsgBox weeklist(i) & vbLf & Cells(5 + k, j + 2).Address & vbLf & cmdilist(j).Value
　　　　　　　　.AutoFilter Field:=2, Criteria1:="=" & cmdilist(j).Value & "*", Operator:=xlAnd
　　　　　　　　With Sheets("集計シート検査")
　　　　　　　　　　.Range("AC4:AF4").Copy
　　　　　　　　　　.Cells(5 + k, j + 2).PasteSpecial _
　　　　　　　　　　　　Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
　　　　　　　　End With
　　　　　　Next j
　　　　　　k = k + 22
　　　　Next i
　　End With
　　Application.CutCopyMode = False
　　Set cmdilist = Nothing
End Sub

補足

ありがとうございます。
コード文をそのままコピーしてはしらせてみました。
うまく走りました。
そこで使っているシートにあわせ書き換えました。
weeklist = Array("月", "火", "水", "木", "金", "土"）
　　　　　　　　↓　（日曜日も含むので）
weeklist = Array("月", "火", "水", "木", "金", "土","日"）

　Set cmdilist = Sheets("集計シート検査").Range("C2:R2")
　　　↓ (17アイテムだったので）
Set cmdilist = Sheets("集計シート検査").Range("C2:S2")

For i = 0 To 5　　→　For i = 0 To 6

　.AutoFilter Field:=8, Criteria1:=weeklist(i)
　　　　　　　　　↓　（曜日は19列目なので）
.AutoFilter Field:=19, Criteria1:=weeklist(i)

For j = 1 To 16→　For j = 1 To 17

　.AutoFilter Field:=2, Criteria1:="=" & cmdilist(j).Value & "*", Operator:=xlAnd
　　　　　　　　　↓（アイテム列は3列目なので）
.AutoFilter Field:=3, ～

とかきかえました。それでマクロを走らせてみましたが
　.AutoFilter Field:=19, Criteria1:=weeklist(i)のところでデバックになりました。
実行時エラー"1004" Range クラスのAutoFilterメゾット失敗～
とかかれています。
調べてみましたが19列目は曜日がでるようになっています。
どうしてでしょうか？

回答No.14

xls88

＞回答番号：No.12 この回答への補足

>weeklist = Array(月, 火, 水, 木, 金, 土, 日)
当方では、コンパイルエラーで、マクロが実行できません。

R列の曜日の表示ですが、
手書きで、月、火、・・・と、入力して試してみればどうなるでしょうか。
あるいは、
=TEXT(A1,"aaa")
として、テキストを出力した場合も試してみてください。

お礼

色々とアドバイスいただきありがとうございます。
曜日表示を手入力、=TEXT(A1,"aaa")　両方とも試してみました。
やはり、月曜のみうまくいきませんでした。
そこで22行最初に挿入して
weeklist = Array("月", "月", "火", "水", "木", "金", "土", "日")
For i = 0 To 7
として実行させました。
とりあえず求めていたデータは"集計シート検査"シートへ反映させることができました。（最初の22行は表示しない）
悔しいですが今回はこの形で行くこととしました。
本当にくやしいです。
長きにわたりお付き合いいただきまして本当にありがとうございました。
マクロ初心者にとって今回はとても勉強させていただきました。
PC,マクロ（コード・変数　・・・等々）楽しいです。
大変ですがもっともっと勉強しようと思っています。
今回のうまくいかない原因も勉強します。
また、なにかありましたら質問投稿させていただきたいと思います。
質問、補足の書き方も他の方の質問を読んで勉強します。
本当にありがとうございました。
最後になりましたがxls88さんてすごいですね！

回答No.13

xls88

回答番号：No.12は、一部間違っていました。
ユーザー定義でaaa なら、表示は、月、火、水、・・・でした、
当方、aaaa としてテストしていました。
お詫びいたします。大変失礼しました。

回答No.12

xls88

＞回答番号：No.11 この回答への補足
月曜以外、上手くいっているということですから良いのかもしれません。
しかし、下記に引用しますが「回答番号：No.8 この回答への補足」との整合性がとれていません。

>曜日列はS列なので
>With Sheets("検査実績貼り付け").Range("A2:S2")
>For i = 0 To 6
>.AutoFilter Field:=19, Criteria1:=weeklist(i)
>For j = 1 To 17
>としています。

また、ユーザー定義でaaa としているなら、表示は「月曜日」というようになるとおもいます。
weeklist = Array("月", "火", "水", "木", "金", "土","日"）
では、該当するものが、Field内には見つからず、抽出できないと思います。

weeklist = Array("月曜日", "火曜日",・・・・
というようにする必要があると思います。
そこら辺はご自分で対応、解決されているということでしょうか？

Rupan5833が、現在試行されている、Excelの内容を正確に教えていたがけないと混乱するだけです。
こちらでは、同じ環境、同じデータが用意できないので、なんとも判断ができません。

補足

すみません。
回答番号11の補足で書いたようなものではわかりにくいでしょうか？

A列は空欄
　B　　　C　　　　～　　　R
日付　商品コード・・・　曜日

Ｒ列で曜日（月～日）を抽出し、Ｃ列で抽出するコードの最初1から2文字で抽出（１７アイテム繰り返す）された項目（ＤからＱ）のうち集計シート検査に必要な項目を集計シート検査のAC4:AE4ににサブトータルを計算させそれをコピー行列入れ替えてＣ5へ貼り付ける・・・・の繰り返しで週報の集計をしています。

検査実績貼り付けシートの一列は不要だったので削除しました。
なので一列寄ってＲ列までとなり曜日列がＲ列になり、それで
>.AutoFilter Field:=18, Criteria1:=weeklist(i)
としました。
weeklist = Array(月, 火, 水, 木, 金, 土,日）としてみましたが
やはり>.AutoFilter Field:=18, Criteria1:=weeklist(i)でオートフィルターの▼はでてきますが月曜日の抽出はできません。
それ以後は何の問題もなく日曜まで完全です。
あと別に
"集計シート検査"シートのAF2～AL2に月から日まで入力し
Dim weeklist As Variant
　　　　↓
　Dim youbi As Range
weeklist = Array(月, 火, 水, 木, 金, 土, 日)
　　　　↓
Set youbi = Sheets("集計シート検査").Range("AF2:AL2")
.AutoFilter Field:=18, Criteria1:=weeklist(i)
　　　　　　　↓
.AutoFilter Field:=18, Criteria1:=youbi(i)
ということもやってみましたが結果は今までと一緒でした。
何か月曜を抽出する方法はありませんでしょうか？

回答No.11

xls88

＞回答番号：No.10 この回答への補足
>集計の件はステップ実行を行ってみました。
>For i = 0 To 6
>.AutoFilter Field:=18, Criteria1:=weeklist(i)
>For j = 1 To 17
>ここでフィルターがかかって曜日を抽出するのだと思うのですが
>月曜は抽出しませんでした。（Next iで火曜日からは全く問題無く抽出しました）
Criteria1:=weeklist(i)がField:=18にみつからないわけですから、そこら辺を調べてみてください。
Field:=18となっていますが、単なる転記ミスですか？
それとも、月曜日のみField:=18なのですか？
微妙に違っていたりしませんか？

補足

色々とありがとうございます。
マクロを実行させるシートは下記のような感じになっています。
AからO列までは他シートよりコピー転記し、P列からQ列までは各種数式にてデータを反映させR列はB列の日付を書式を変えて曜日表記（ユーザー定義でaaa)しています。
A列は空欄
　B　　　C　　　　～　　　R
日付　商品コード・・・　曜日
なのでR列＝Bの曜日です。
weeklistはxls88さんに提案していただいたままコピーして日曜のみ追加してweeklist = Array("月", "火", "水", "木", "金", "土", "日")としています。　
なので
Criteria1:=weeklist(i)は18列め(R列）になると思うのですが・・・
>For i = 0 To 6
>.AutoFilter Field:=18, Criteria1:=weeklist(i)
でフィルターはかかっています。

追伸
あとオートフィルターの初期化というのはオートフィルターを解除するということでしょうか？　マクロ実行後オートフィルターは解除させてマクロ終了としています。

回答No.10

xls88

＞回答番号：No.9 この回答への補足
2回目にデバックが起こる件は、
データの入れ替えで、何が変わっているか調べたらどうでしょうか。
こちらでは、同じ環境、同じデータが用意できないので、何とも判断ができません。
試しに、2回目のマクロ実行前に、フィルターモードを初期化して行えばどうなるでしょうか。

集計の件ですが
Range("AC4:AF4").Copy
しているだけです。
AC4:AF4の数式の結果がそうなっているのではないでしょうか。

デバッグについて
http://members.jcom.home.ne.jp/rex-uchida/vba110.htm
ステップ実行
http://hp.vector.co.jp/authors/VA016119/step/step01.html
ローカルウインドウでのデバッグ
http://www.nikonet.or.jp/spring/sanae/program/vba/vba_11.htm

補足

デバックはデータを入れ替えずに2回目実行させても起こりました。
すみませんフィルターモードを初期化はわからないので調べてやってみようとおもいます。

集計の件はステップ実行を行ってみました。
For i = 0 To 6
.AutoFilter Field:=18, Criteria1:=weeklist(i)
For j = 1 To 17
ここでフィルターがかかって曜日を抽出するのだと思うのですが
月曜は抽出しませんでした。（Next iで火曜日からは全く問題無く抽出しました）
For j = 1 To 17
.AutoFilter Field:=3, Criteria1:=cmdilist(j).Value & "*"
はちゃんとアイテム毎に抽出しているのが確認できました。
アドバイスをお願い致します。

回答No.9

xls88

＞回答番号：No.8 この回答への補足

.AutoFilter Field:=19, Criteria1:=weeklist(i)
試しに、Field と Criteria1 を他のものに変えてやってみればどうなるでしょうか。
あるいは、無駄かも知れませんが、新しいブック、新しいシート、、、環境を変えて確認してみてください。

補足

何度かやってみてわかったことはシートを開きデータを貼り付けて走らせる1回目はうまくいきますがシートを開いたままでデータを入れ替え、2回目を走らせると必ず.AutoFilter ～の二箇所どちらかでデバックが起こります。中止（■）で切り抜けてももう一箇所でデバックされます。
すみませんもう一つ検証してみてわかったことなのですがマクロを走らせて求めている集計ができているか確認したところ月曜日の集計は１週間分の合計集計になっていました。火曜から日曜はその日の集計がはりつけられているのですが・・・
次々とすみません。

回答No.8

xls88

フィルター範囲は合っていますか？
With Sheets("検査実績貼り付け").Range("A2:H2")

補足

お手数をおかけします。
曜日列はS列なので
With Sheets("検査実績貼り付け").Range("A2:S2")
For i = 0 To 6
.AutoFilter Field:=19, Criteria1:=weeklist(i)
For j = 1 To 17
としています。

回答No.6

xls88

＞回答番号：No.5 この回答への補足
>Rows("2:2").AutoFilter
>Selection.AutoFilter Field:=19,Criteria1:="月"
>になるでしょうか？
>Rows("2:2").AutoFilter　Field:=19,Criteria1:="月"
>にするとマクロにダメだしされました。
と、いうことですが

ダメ出しの内容はどうなっていますか？
ダメ出しされたのは、マクロを実行したときですか？

と、いったような情報を教えていただかないと、無駄な遣り取りを繰り返すことになります。

それで、同じ補足欄で掲載されたコードの8行目に、全く同じ構文があるのですが
Sheets("検査実績貼り付け").Rows("2:2").AutoFilter Field:=3, Criteria1:="=商品B*", Operator:=xlAnd
こちらは通っているのですか？
ダメ出しされたのとは別問題だと思いますが、先のコードもきちんとシート名で修飾した方が良いですよ。
シート名がない場合は、マクロ実行時のアクティブなシートが操作対象になります。

同じく補足で掲載されたコードで
>Sheets("集計シート検査").Select
>Range("AC4:AF4").Copy
>Range("C5").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
の部分は
Sheets("集計シート検査").Range("AC4:AF4").Copy
Sheets("集計シート検査").Range("C5").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
というようにSelectしなくても大丈夫なはずです。
更に、Withステートメントを使えば
With Sheets("集計シート検査")
　　.Range("AC4:AF4").Copy
　　.Range("C5").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
End With
というふうに纏めることもできます。

全体のコードで必要なのは下記部分だけではないですか？
Sheets("検査実績貼り付け").Rows("2:2").AutoFilter Field:=8, Criteria1:=(★1)
Sheets("検査実績貼り付け").Rows("2:2").AutoFilter Field:=2, Criteria1:=(★2), Operator:=xlAnd
Sheets("集計シート検査").Select
Range("AC4:AF4").Copy
Range((★3)).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
(★1)～(★3)を変数化して、For文でLoopできるように思います。

補足

お世話をお掛けいたします。
私も構文をみてそのように思っておりました。
色々とPCサイトや質問箱を参照して初めて変数（？）を書いてみました。

Sheets("検査実績貼り付け").Rows("2:2").AutoFilter Field:=8, Criteria1:=(★1)
（★1）は
Dim i As String
For i = "月" To "日"
Sheets("検査実績貼り付け").Rows("2:2").AutoFilter Field:=8, Criteria1:=(i&"*"))
Next
End Sub

Sheets("検査実績貼り付け").Rows("2:2").AutoFilter Field:=2, Criteria1:=(★2), Operator:=xlAnd
Sheets("集計シート検査").Select
Range("AC4:AF4").Copy

（★2）は
Dim i As String
For i = 1 To 6
Sheets("検査実績貼り付け").Rows("2:2").AutoFilter Field:=8, Criteria1:=(i&"*"))
Next
End Sub

Range((★3)).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

（★3）は
ActiveOffset(0,1)
これは直接　Range((★3)).の代わりにいれてみました。

よくわかりませんが・・・だめですかね？？
しかしどのように構文に挿入させたらよいのか
よくわかりません
アドバイスをおねがいいたします。
ここをクリアしないとLoopへは進めませんよね。

回答No.5

hallo-2007

申し訳ありませんが、どういう結果が目的なのか見えてきません。
Selection.AutoFilter Field:=3, Criteria1:="=10*", Operator:=xlAnd
Sheets("集計シート検査").Select
Range("R4").Select
Selection.Copy
ActiveWindow.SmallScroll ToRight:=-5
Range("C5").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
オートフィルターせっかく掛けても集計シート検査のR4をC5にコピィ、ペーストですよね。
n-junさんも指摘されているように、具体的なレイアウト提示してもらったほうが良いと思います。
例
検査実績貼り付け
　A　　　B　　　C　　D
　曜日　　商品名　項目　検査評価点数
　 月　　　A製品　あ　　　90
・・・・
集計シート検査
　A　　B　　　C　　　　D　　・・・
曜日　項目　A商品　　B商品
月　　　あ
　　　　い
　　　　う
　　　　え
火　　　あ
　　　　い
・・・
とかいった具合で、あとデータの並び順とかも重要です。

補足

お世話になります。

例
検査実績貼り付け
　　　A　　　　B　　　C　・・・　　　H　
　　商品名　　項目　　小計　・・・　曜日
　 　A商品　　　あ　　90　　・・・　　月
・・・・
集計シート検査
　A　　B　　　C　　　　D　　・・・
曜日　項目　A商品　　B商品　・・・　G9商品
月　　　あ
　　　　い
　　　　う
　　　　え
　　　　お
　　　　～
火　　　あ
　　　　い
・・・
という感じに直しました。項目は22項目（その中の4項目をマクロでうめたいのです）　商品は16商品あります。
で、構文はxls88さんのアドバイスを受け、だいぶすっきりしました。
が、自分で見てももっと短くできる感じがします。
色々調べてやろうとチャレンジしましたがあまりよくわかりませんでした。
構文は
Rows("2:2").AutoFilter
Selection.AutoFilter Field:=8, Criteria1:="月"
Selection.AutoFilter Field:=2, Criteria1:="=商品A*", Operator:=xlAnd
Sheets("集計シート検査").Select
Range("AC4:AF4").Copy
Range("C5").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Sheets("検査実績貼り付け").Rows("2:2").AutoFilter Field:=3, Criteria1:="=商品B*", Operator:=xlAnd
Sheets("集計シート検査").Select
Range("AC4:AF4").Copy
Range("D5").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
～・・・
Sheets("検査実績貼り付け").Rows("2:2").AutoFilter Field:=2, Criteria1:="=商品F*", Operator:=xlAnd
Sheets("集計シート検査").Select
Range("AC4:AF4").Copy
Range("I5").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Sheets("検査実績貼り付け").Rows("2:2").AutoFilter Field:=2, Criteria1:="=商品G0*", Operator:=xlAnd
Sheets("集計シート検査").Select
Range("AC4:AF4").Copy
Range("J5").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Sheets("検査実績貼り付け").Rows("2:2").AutoFilter Field:=2, Criteria1:="=G2*", Operator:=xlAnd
Sheets("集計シート検査").Select
Range("AC4:AF4").Copy
Range("K5").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
～・・・
Sheets("検査実績貼り付け").Rows("2:2").AutoFilter Field:=2, Criteria1:="=G9*", Operator:=xlAnd
Sheets("集計シート検査").Select
Range("AC4:AF4").Copy
Range("S5").PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True

Sheets("検査実績貼り付け").Select
Selection.AutoFilter Field:=8, Criteria1:="火"
Selection.AutoFilter Field:=2, Criteria1:="=0*", Operator:=xlAnd
Sheets("集計シート検査").Select
という感じです。
Range("AC4:AF4").Copy　は各項目のサブトータルが入っているセルです。
月曜日でフィルターをかけた後同じ作業が商品ごとくりかえしています。
火曜日も月曜日と同じ事をさせていますが行は22行下への貼り付けとなります。
これも繰り返し作業のマクロだと思うのですが・・・
アドバイスをおねがいいたします。

追伸：xls88さんへ
コードまとめですが
Rows("2:2").AutoFilter
Selection.AutoFilter Field:=19,Criteria1:="月"
になるでしょうか？
Rows("2:2").AutoFilter　Field:=19,Criteria1:="月"
にするとマクロにダメだしされました。

回答No.4

xls88

＞回答番号：No.1 この回答への補足

≪1≫
マクロ実行時に画面をスクロールする必要はないですね。
（多分「マクロの記録」で実操作が記録されたものだとおもいます。）
下記のようなコードは削除しても大丈夫です。
ActiveWindow.SmallScroll ToRight:=2

いきなり削除しても良いのですが、コメントアウトして、しばらく様子を見る手段があります。
行の先頭に、'（アポストロフィ）を入力します。マクロを実行してもその行は実行されません。
なくても問題がないことを確認してから、おもむろに削除してください。
'ActiveWindow.SmallScroll ToRight:=2

≪2≫
マクロにおいては、Select、Selectionする必要のない場合がほとんどです。
例えば
Rows("2:2").Select
Selection.AutoFilter
の2行は
Rows("2:2").AutoFilter
と1行に纏めることができます。
ついでに言えば、行全体にオートフィルタをかけるのは無駄です。
下記のように対象範囲を指定しましょう。
Range("A2:Z2").AutoFilter

もう一例
Sheets("集計シート検査").Select
Range("R4").Select
Selection.Copy
上記3行は
Sheets("集計シート検査").Range("R4").Copy
というようになります。

ということで、下記コードはどうまとまるか分かりますでしょうか。
Rows("2:2").Select
Selection.AutoFilter
ActiveWindow.SmallScroll ToRight:=2
Selection.AutoFilter Field:=19, Criteria1:="月"

≪3≫
「値」のみを取り出すのなら
Sheets("Sheet2").Range("A1:C1").Value = Sheets("Sheet1").Range("A5:C5").Value
とすれば、生真面目にCopyして、PasteSpecialする必要もありません。

≪4≫
あと、コピー元とコピー先の相対位置に規則性を見つけて、For～Next文でループするようにすればよいと思います。

取りあえず、ここまでにします。