Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


54431 / 76732 ←次へ | 前へ→

【27094】オートフィルタで抽出したものを別シート...
質問  RIKU  - 05/7/28(木) 20:37 -

引用なし
パスワード
   こんにちは。過去ログを拝見しましたが、うまく流用できないので教えてください。

【概要】
下記メイン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.うまく説明できてませんが、ご教授宜しくお願います。

1 hits

【27094】オートフィルタで抽出したものを別シート... RIKU 05/7/28(木) 20:37 質問
【27128】Re:オートフィルタで抽出したものを別シー... Jaka 05/7/29(金) 14:10 回答
【27147】新たな問題点3-5 RIKU 05/7/30(土) 4:21 質問
【27148】Re:オートフィルタで抽出したものを別シー... RIKU 05/7/30(土) 5:03 質問
【27190】Re:オートフィルタで抽出したものを別シー... Jaka 05/8/1(月) 14:44 発言

54431 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free