| |
こんにちは。過去ログを拝見しましたが、うまく流用できないので教えてください。
【概要】
下記メイン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 ７月 ８月 ９月 ・・・
10 ITEM 納入コード 数量 10/20/30 10/20/30 10/20/30
11 ○△商事
12 １ ブラウス ２０ -------
13 ２ スカート １０ --------
14 ３ Ｔシャツ １０ -------
15 ４ パンツ ３０ -----
16 ５ ジャケット１０ ----
17
18 ７月 ８月 ９月 ・・・
19 ITEM 納入コード 数量 10/20/30 10/20/30 10/20/30
20 (株)□×
21 １ ブラウス ３０ ------
22 ２ スカート ５ -----
23 ３ Ｔシャツ １５ -----
24 ４ パンツ ２０ -----
25 ６ コート ５ -----
26
27 ７月 ８月 ９月 ・・・
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
'１〜最大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・・・の箇所をＷクリックして列幅を整える行為なんですが、変数宣言をどう表現していいかわかりません。
2.項目のコピーですが、項目は9行目&10行目なのでこの2行分もっていき
たいのですが、どう直してみても9、10行目どちらか一方しかもってこないのです。
3.作成して途中で気づいたのですが、Ｂ１０の納入コード（NO,○○-○○）を
コピー先（各アイテムNO,で抽出したsheet）のA列に入れたいのですが、
上記のどの部分にどう追加すればいいのかわかりません。難点は、アイテムNO,の数がユニークですので、納入コードが何行ごとに入るかはバラバラなんです。
PS.うまく説明できてませんが、ご教授宜しくお願います。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
