|
こんにちは。過去ログを拝見しましたが、うまく流用できないので教えてください。
【概要】
下記メインsheetがあります。項目は9〜10行目にあります。
注記のように、種別によってアイテムNO,がA列に入っており、納入コード(NO,○○-○○)で1グループとして括っており、そのアイテムNO,数は納入コードによってユニークです。
アイテムNO,は全部で約50あります。
D列以降の「------」はオートシェイプの線でそれぞれのスケジュールを表します。行数(グループの括り:納入コード数)も列数(月日)も日々増えます。
【目的】
メインsheetのA列(ITEM NO,)でオートフィルタかけ、メインsheetの右側に各アイテムNO,ごとに各アイテムNO,の名前sheetにしてフィルタで抽出したもの(項目を含む)をコピーして行きたいのです。そして、アイテムごとに「今月はスカートが負荷が高い」や「9月はTシャツが少ない」などと、種別に管理できるようにしたいのです。このマクロ実行するごとに日々、更新されるようにしたいのです。
【メインsheet:sample】
A B C D E F G H I J K L ・・・
1
2 注記アイテムNO,1・・・ブラウス類
3 2・・・スカート類
4 3・・・Tシャツ類
5 4・・・パンツ類
6 5・・・ジャケット類
7 6・・・コート類
8
9 7月 8月 9月 ・・・
10 ITEM 納入コード 数量 10/20/30 10/20/30 10/20/30
11 ○△商事
12 1 ブラウス 20 -------
13 2 スカート 10 --------
14 3 Tシャツ 10 -------
15 4 パンツ 30 -----
16 5 ジャケット10 ----
17
18 7月 8月 9月 ・・・
19 ITEM 納入コード 数量 10/20/30 10/20/30 10/20/30
20 (株)□×
21 1 ブラウス 30 ------
22 2 スカート 5 -----
23 3 Tシャツ 15 -----
24 4 パンツ 20 -----
25 6 コート 5 -----
26
27 7月 8月 9月 ・・・
28 ITEM 納入コード 数量 10/20/30 10/20/30 10/20/30
29
30 △△(株)
31 ・
32 ・
33 ・
34 ・
【現状の自作マクロ】
Option Explicit
Sub シート作成マクロ()
Dim itemsheet As Worksheet
Dim itemretsu As Integer
Dim itemmax As Integer
Application.ScreenUpdating = False
itemmax = WorksheetFunction.Max(Sheets("メイン").Range("a:a"))
For itemretsu = itemmax To 1 Step -1
Set itemsheet = Sheets.Add(Type:=xlWorksheet)
itemsheet.Name = itemretsu
ActiveSheet.Move after:=Worksheets("メイン")
Next itemretsu
Application.ScreenUpdating = True
End Sub
Sub ITEM別抽出マクロ_1()
Dim itemmax As Integer, i As Integer, maxcol As Integer
Dim tbl As Range, tblR As Range
Application.ScreenUpdating = False
With Sheets("メイン")
itemmax = WorksheetFunction.Max(.Range("a:a"))
' 最大のITEMナンバーの取得
maxcol = .Cells(9, 256).End(xlToLeft).Column
'最大列の取得
Set tbl = .Range("A9", .Range("A65536").End(xlUp))
'フィルターにかける範囲を設定
For i = 1 To itemmax
'1〜最大ITEMナンバーまで繰り返し作業する
ActiveSheet.AutoFilterMode = False
'フィルターモードの取り消し
tbl.AutoFilter
'範囲をフィルター設定
'Sheets("" & i & "").Cells.Clear
tbl.AutoFilter field:=1, Criteria1:="" & i & ""
'目的のデータを抽出
Set tblR = .Range(.Cells(9, 1), .Cells(.Range("a65536").End_(xlUp).Row, maxcol))
tblR.Copy Destination:=Sheets("" & i & "").Range("a3")
'それをそれぞれのシートにコピー
☆ cell.EntireColumn.AutoFit
Rows("4:4").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.RowHeight = 25
Range("B7").Select
ActiveWindow.Zoom = 75
Range("A1").Select
'セル列幅を整え 行高さ25、ズーム75%に設定
Next i
tbl.AutoFilter field:=1
End With
Application.ScreenUpdating = True
End Sub
【問題点】
1.上記のようなマクロ組んでみたのですが、☆部分でデバッグかかります。
変数宣言をしていないからなのですが、これは列番のA,B,C・・・の箇所をWクリックして列幅を整える行為なんですが、変数宣言をどう表現していいかわかりません。
2.項目のコピーですが、項目は9行目&10行目なのでこの2行分もっていき
たいのですが、どう直してみても9、10行目どちらか一方しかもってこないのです。
3.作成して途中で気づいたのですが、B10の納入コード(NO,○○-○○)を
コピー先(各アイテムNO,で抽出したsheet)のA列に入れたいのですが、
上記のどの部分にどう追加すればいいのかわかりません。難点は、アイテムNO,の数がユニークですので、納入コードが何行ごとに入るかはバラバラなんです。
PS.うまく説明できてませんが、ご教授宜しくお願います。
|
|