[[20170926142012]]　『商品名の行を揃えます』（akio）　ページの最後に飛ぶ

『商品名の行を揃えます』（akio）

お世話になります。

質問：下記の商品名の項目詳細を今月と先月を比較して見やすくする為に、
今月と先月の同じ商品名のどちらか商品名の多いデータの最後の行から2行下
に空けて次の商品名を表示したいのです。
下記?@が元のデータ　　?Aが希望するデータの並びです。（日付、購入者、金
額の詳細は省いています。）本来100行ほどデータ行があります。

よろしくお願いいたします。

    Ａ列　Ｂ列　　Ｃ列　　Ｄ列　　Ｅ列　　Ｆ列　　Ｇ列　　Ｈ列
1行 ?@今月				先月			
２行日付　商品名　購入者　金額	　日付	商品名	購入者	　金額
	水着a				水着a		
	水着a				水着a		
	水着a				水着a		
	ゴーグルｂ				水着a		
	ゴーグルｂ				水着a		
	ゴーグルｂ				ゴーグルｂ		
	ゴーグルｂ				ゴーグルｂ		
	ゴーグルｂ				ゴーグルｂ		
	鞄a				鞄a		
	鞄a				鞄a		
	鞄a				鞄a		
					鞄a		
					鞄a		
　　　　J列　　Ｋ列　　L列　　Ｍ列　　　Ｎ列　０列　　Ｐ列　　Ｑ列　
１行?A今月				先月			
２行日付商品名	購入者	金額	日付	商品名	購入者	金額
	水着a				水着a		
	水着a				水着a		
	水着a				水着a		
					水着a		
					水着a

	ゴーグルｂ				ゴーグルｂ		ゴーグルｂ				ゴーグルｂ		ゴーグルｂ				ゴーグルｂ		ゴーグルｂ						
	ゴーグルｂ

	鞄a				鞄a		
	鞄a				鞄a		
	鞄a				鞄a		
					鞄a		
					鞄a

＜使用 Excel：Excel2013、使用 OS：Windows10 ＞

 ずれすぎてて分からないので、以下の仕様でいいですか？
 おそらくソートされた後のデータだと思います。

 私の提案は元データを３）のような形にして、ピボットテーブルでの比較が一番簡単だと思います。
 １）元データ
     |[A]   |[B]       |[C]   |[D]   |[E]   |[F]       |[G]   |[H]   
 [1] |　日付|商品名    |購入者|　金額|　日付|商品名    |購入者|　金額
 [2] |      |水着a     |      |      |      |水着a     |      |      
 [3] |      |水着a     |      |      |      |水着a     |      |      
 [4] |      |水着a     |      |      |      |水着a     |      |      
 [5] |      |ゴーグルｂ|      |      |      |水着a     |      |      
 [6] |      |ゴーグルｂ|      |      |      |水着a     |      |      
 [7] |      |ゴーグルｂ|      |      |      |ゴーグルｂ|      |      
 [8] |      |ゴーグルｂ|      |      |      |ゴーグルｂ|      |      
 [9] |      |ゴーグルｂ|      |      |      |ゴーグルｂ|      |      
 [10]|      |鞄a       |      |      |      |鞄a       |      |      
 [11]|      |鞄a       |      |      |      |鞄a       |      |      
 [12]|      |鞄a       |      |      |      |鞄a       |      |      
 [13]|      |          |      |      |      |鞄a       |      |      
 [14]|      |          |      |      |      |鞄a       |      |

 ２）整形後
     |[J]   |[K]       |[L]   |[M]   |[N]   |[O]       |[P]   |[Q]   
 [1] |　日付|商品名    |購入者|　金額|　日付|商品名    |購入者|　金額
 [2] |      |水着a     |      |      |      |水着a     |      |      
 [3] |      |水着a     |      |      |      |水着a     |      |      
 [4] |      |水着a     |      |      |      |水着a     |      |      
 [5] |      |          |      |      |      |水着a     |      |      
 [6] |      |          |      |      |      |水着a     |      |      
 [7] |      |ゴーグルｂ|      |      |      |ゴーグルｂ|      |      
 [8] |      |ゴーグルｂ|      |      |      |ゴーグルｂ|      |      
 [9] |      |ゴーグルｂ|      |      |      |ゴーグルｂ|      |      
 [10]|      |ゴーグルｂ|      |      |      |          |      |      
 [11]|      |ゴーグルｂ|      |      |      |          |      |      
 [12]|      |鞄a       |      |      |      |鞄a       |      |      
 [13]|      |鞄a       |      |      |      |鞄a       |      |      
 [14]|      |鞄a       |      |      |      |鞄a       |      |      
 [15]|      |          |      |      |      |鞄a       |      |      
 [16]|      |          |      |      |      |鞄a       |      |

 ３）希望する元データ
     |[A]    |[B]       |[C]   |[D]   
 [1] |　日付 |商品名    |購入者|　金額
 [2] |9月1日 |水着a     |      |      
 [3] |9月1日 |水着a     |      |      
 [4] |9月1日 |水着a     |      |      
 [5] |9月1日 |ゴーグルｂ|      |      
 [6] |9月1日 |ゴーグルｂ|      |      
 [7] |9月1日 |ゴーグルｂ|      |      
 [8] |9月1日 |ゴーグルｂ|      |      
 [9] |9月1日 |ゴーグルｂ|      |      
 [10]|9月1日 |鞄a       |      |      
 [11]|9月1日 |鞄a       |      |      
 [12]|9月1日 |鞄a       |      |      
 [13]|10月1日|水着a     |      |      
 [14]|10月1日|水着a     |      |      
 [15]|10月1日|水着a     |      |      
 [16]|10月1日|水着a     |      |      
 [17]|10月1日|水着a     |      |      
 [18]|10月1日|ゴーグルｂ|      |      
 [19]|10月1日|ゴーグルｂ|      |      
 [20]|10月1日|ゴーグルｂ|      |      
 [21]|10月1日|鞄a       |      |      
 [22]|10月1日|鞄a       |      |      
 [23]|10月1日|鞄a       |      |      
 [24]|10月1日|鞄a       |      |      
 [25]|10月1日|鞄a       |      |      
（稲葉） 2017/09/26(火) 16:33

Sub main()
'元データ＝sheet1
'変更後＝sheet2

    Dim dic As Object, dic1 As Object, dic2 As Object, i As Long, c As Range, r As Range, k
    Sheets("Sheet2").Cells.ClearContents
    Sheets("Sheet1").Range("A1:H2").Copy Sheets("Sheet2").Range("A1")
    Set dic = CreateObject("Scripting.Dictionary")
    Set dic1 = CreateObject("Scripting.Dictionary")
    Set dic2 = CreateObject("Scripting.Dictionary")
    For Each c In Sheets("Sheet1").Range("B3:B" & Rows.Count).SpecialCells(xlCellTypeConstants)
        dic1(c.Value) = dic1(c.Value) + 1
        dic(c.Value) = True
    Next c
    For Each c In Sheets("Sheet1").Range("F3:F" & Rows.Count).SpecialCells(xlCellTypeConstants)
        dic2(c.Value) = dic2(c.Value) + 1
        dic(c.Value) = True
    Next c
    Set r = Sheets("Sheet2").Range("B3")
    For Each k In dic
        For i = 1 To WorksheetFunction.Max(dic1(k), dic2(k))
            If i <= dic1(k) Then r.Value = k
            If i <= dic2(k) Then r.Offset(, 4).Value = k
            Set r = r.Offset(1)
        Next i
        Set r = r.Offset(2)
    Next k
    Set r = Sheets("Sheet1").Range("A3")
    For Each c In Sheets("Sheet2").Range("B3:B" & Rows.Count).SpecialCells(xlCellTypeConstants)
        c.Offset(, -1).Resize(, 4).Value = r.Resize(, 4).Value
        Set r = r.Offset(1)
    Next c
    Set r = Sheets("Sheet1").Range("E3")
    For Each c In Sheets("Sheet2").Range("F3:F" & Rows.Count).SpecialCells(xlCellTypeConstants)
        c.Offset(, -1).Resize(, 4).Value = r.Resize(, 4).Value
        Set r = r.Offset(1)
    Next c
End Sub
（mm） 2017/09/26(火) 16:40

稲葉様、有難うございました。

mm様、
マクロ、有難うございました。
希望通り行きました。
只、
実際に使って色々試して気づいたのですが、
商品別に小計を入れるのを忘れていました。すみませんでした。

商品別に小計を入れたとしましたら
コードの追加としてどこに何を入れたらいいのですか？
教えて下さい。

（akio） 2017/09/26(火) 23:35

    For Each k In dic
        Set sr = r
        For i = 1 To WorksheetFunction.Max(dic1(k), dic2(k))
            If i <= dic1(k) Then r.Value = k
            If i <= dic2(k) Then r.Offset(, 4).Value = k
            Set r = r.Offset(1)
        Next i
        r.Offset(, 1).Resize(, 2).Value = Array("小計", "=sum(D" & sr.Row & ":D" & r.Offset(-1).Row & ")") '小計
        r.Offset(, 5).Resize(, 2).Value = Array("小計", "=sum(H" & sr.Row & ":H" & r.Offset(-1).Row & ")") '小計
        Set r = r.Offset(2)
    Next k
（mm） 2017/09/27(水) 10:23

mm様
こんにちは、
凄いです、うまく行きました。
私のつたない説明なのにご理解いただき
嬉しいです。

本当に有難うございます。

（akio） 2017/09/27(水) 11:15

コメント返信：

[ 一覧(最新更新順) ]

[[20170926142012]] 『商品名の行を揃えます』（akio） ページの最後に飛ぶ

[[20170926142012]]　『商品名の行を揃えます』（akio）　ページの最後に飛ぶ