[[20170507071318]]　『別シートに日付及び営業所別に振り分けしたい。』（さち）　ページの最後に飛ぶ

『別シートに日付及び営業所別に振り分けしたい。』（さち）

お世話になります。
説明が下手でわかりにくくてすいません。
シート1で日付と営業所名を入力するとシート2のように上旬中旬下旬及び営業所別にに自動で振り分けをしたいのですが
宜しくお願いします。

シート1

     |[A]       |[B] |[C]   |[D] |[E] |[F]   |[G] 
 [1] |          |    |      |    |    |営業所|    
 [2] |          |日付|商品  |数量|東京|大阪  |九州
 [3] |          |4/5 |リンゴ|  20|千葉|      |    
 [4] |4/4～4/10 |4/5 |メロン|  30|    |      |佐賀
 [5] |          |4/6 |桃    |  10|千葉|      |    
 [6] |          |4/10|バナナ|  40|茨木|      |    
 [7] |          |    |      |    |    |      |    
 [8] |          |    |      |    |    |営業所|    
 [9] |          |日付|商品  |数量|東京|大阪  |九州
 [10]|          |4/16|みかん|  15|埼玉|      |    
 [11]|4/11～4/20|4/19|すいか|  10|千葉|      |    
 [12]|          |    |      |    |    |      |    
 [13]|          |    |      |    |    |      |    
 [14]|          |    |      |    |    |      |

シート2

     |[A]   |[B]   |[C] |[D]|[E] |[F]|[G]   |[H]   |[I] |[J]|[K] 
 [1] |      |      |上旬|   |    |   |      |      |中旬|   |    
 [2] |営業所|商品  |数量|   |日付|   |営業所|商品  |数量|   |日付
 [3] |千葉  |リンゴ|  20|   |4/5 |   |千葉  |すいか|  10|   |4/19
 [4] |      |桃    |  10|   |4/6 |   |      |      |    |   |    
 [5] |茨木  |バナナ|  40|   |4/10|   |茨木  |      |    |   |    
 [6] |      |      |    |   |    |   |      |      |    |   |    
 [7] |埼玉  |      |    |   |    |   |埼玉  |みかん|  15|   |4/16
 [8] |      |      |    |   |    |   |      |      |    |   |    
 [9] |佐賀  |メロン|  30|   |4/5 |   |佐賀  |      |    |   |    
 [10]|      |      |    |   |    |   |      |      |    |   |

＜使用 Excel：Excel2003、使用 OS：Windows7 ＞

 回答ではありません。

 私は、
 ・もっと標準的なExcelの表にしておくこと、
 ・ピボットテーブルの利用
 を薦めます。

 【シート1】
      A列     B        C       D       E       F
 1    日付    サイクル 営業所  地域    商品    数量
 2    4月5日  4月上旬  千葉    東京    リンゴ  20
 3    4月5日  4月上旬  佐賀    九州    メロン  30
 4    4月6日  4月上旬  千葉    東京    桃      10
 5    4月10日 4月上旬  茨木    東京    バナナ  40
 6    4月16日 4月中旬  埼玉    東京    みかん  15
 7    4月19日 4月中旬  千葉    東京    すいか  10

 【シート2】
      A列      B       C       D       E       F
 1    サイクル 地域    営業所  日付    商品    数量
 2    4月上旬  東京    茨木    4月10日 バナナ  40
 3                     千葉    4月5日  リンゴ  20
 4                             4月6日  桃      10
 5             九州    佐賀    4月5日  メロン  30
 6    4月中旬  東京    埼玉    4月16日 みかん  15
 7                     千葉    4月19日 すいか  10

 シート1は正規化が不十分との意見もあろうが、
 B,Dは計算式対応するという折衷案です。

 色々なニーズにアドホックな帳票を逐一　VBAで設計していては
 身が持ちませんよ。（リクエストするだけなら簡単だが）
 社会全体の損失と言っても大げさではないです。

 ピボットテーブルなら、
 ・集計項目の付加、削除
 ・項目のソート順
 ・表のレイアウト変更
 など簡単な操作で自由自在です。

（γ） 2017/05/07(日) 11:25

マクロ例です。

 ・シート２の見出し行は、予め準備しておいてください。
 ・データは１ヶ月分のみしかないという前提です。

 でも、コードみてもおそらくチンプンカンプンで
 将来、条件を少し変更したいだけでも困ることになりそうです。
 全面書き直しが必要となるケースも多いかと思います。

γさんが言われているとおり、ピボットテーブル利用がよいと思います。

 Option Explicit

 Sub test()
    Dim dic As Object
    Dim c As Range
    Dim 日付, 商品 As String, 数量 As Long, 営業所 As String
    Dim p As Long
    Dim k
    Dim n As Long

    Set dic = CreateObject("scripting.dictionary")

    For Each c In Worksheets("Sheet1").UsedRange.Columns(2).Cells
        日付 = c.Value
        If IsDate(日付) Then
            商品 = c.Offset(, 1).Value
            数量 = c.Offset(, 2).Value
            営業所 = c.Offset(, 3).Value & c.Offset(, 4).Value & c.Offset(, 5).Value

            If Not dic.exists(営業所) Then
                Set dic(営業所) = CreateObject("scripting.dictionary")
                For p = 0 To 2
                    Set dic(営業所)(p) = CreateObject("scripting.dictionary")
                Next
            End If

            Select Case Day(日付)
                Case Is <= 10: p = 0
                Case Is <= 20: p = 1
                Case Else: p = 2
            End Select

            dic(営業所)(p)(日付 & 商品) = Array(営業所, 商品, 数量, Empty, 日付)

        End If
    Next

    With Worksheets("Sheet2")
        .UsedRange.Offset(2).ClearContents

        For Each k In dic
            n = WorksheetFunction.Max( _
                .Range("C" & Rows.Count).End(xlUp).Row, _
                .Range("I" & Rows.Count).End(xlUp).Row, _
                .Range("O" & Rows.Count).End(xlUp).Row)

            For p = 0 To 2
                If dic(k)(p).Count > 0 Then
                    .Range("A1").Offset(n, p * 6).Resize(dic(k)(p).Count, 5).Value = _
                        WorksheetFunction.Transpose(WorksheetFunction.Transpose(dic(k)(p).items))
                End If
            Next
        Next
    End With

 End Sub

（マナ） 2017/05/07(日) 15:50

コメント返信：

[ 一覧(最新更新順) ]

[[20170507071318]] 『別シートに日付及び営業所別に振り分けしたい。』（さち） ページの最後に飛ぶ

[[20170507071318]]　『別シートに日付及び営業所別に振り分けしたい。』（さち）　ページの最後に飛ぶ