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

質問

１週間分のデータの集計をします。
オートフィルターをかけ曜日で絞りかつ商品毎（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.3

n-jun

１５アイテム（位？）×４項目位（？）のシートに振り分ける？
曜日がどのようなデータで代入（表示？）されているのかわかりませんが、
月曜～日曜（？）でソートしてから、アイテムと項目で抽出していくとか。

たぶんですけど「構文を短くしたい」とは、その作業を行なおうとすると（マクロの自動記録）
だらだら長くなってしまうので、他の方法を聞きたいように感じるのですが、
結局どのようなデータを、どのようにしたいのかを、具体的なレイアウトを提示し
説明された方が伝わりやすいと思います。

的はずれならごめんなさい。

回答No.2

hallo-2007

え～っ　と思うのですが、
7曜日＊１５アイテム＊４項目　４２０枚のシートに分けてコピィする
エクセル（パソコン？）の限界超えるかもしれません。
>１週間分のデータの集計をします。
結果、どのような集計を希望されるのでしょうか。
1枚のシートから方が集計は簡単なはずです。
目的の方を質問されたほうが良いと思います。

回答No.1

xls88

Excel(エクセル) VBA入門：繰り返し処理(For～Next,Do～Loop)
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_for_next.html

現状使われているコードを提示してください。
実際のコードを拝見する方がアドバイスし易くなります。

補足

皆さん色々お世話になります。
xls88さん
構文は
Rows("2:2").Select
Selection.AutoFilter
ActiveWindow.SmallScroll ToRight:=2
Selection.AutoFilter Field:=19, Criteria1:="月"
ActiveWindow.ScrollColumn = 1
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
ActiveWindow.ScrollColumn = 10
　～
Range("S4").Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.ScrollColumn = 1
Range("C14").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Sheets("検査実績貼り付け").Select
Selection.AutoFilter Field:=3, Criteria1:="=11*", Operator:=xlAnd
Sheets("集計シート検査").Select
ActiveWindow.SmallScroll ToRight:=3
Range("R5").Select
Application.CutCopyMode = False
Selection.Copy
　～
というようなコードが続きます。
halloさん
コピーをはるシート先は1シートになります。
ペースト位置が結構バラバラです。
n-jonさん
「たぶんですけど「構文を短くしたい」とは、その作業を行なおうとすると（マクロの自動記録）
だらだら長くなってしまうので、他の方法を聞きたいように感じるのですが」
すみません。そのとおりです。