複数データをまとめる。ピポットテーブルでは対応できない集計。

2020年10月24日

依頼内容：複数ユーザーのデータを、まとめる。この際に付与されている「リストID」を、横軸に並べてほしい。

・ピポットでは難しい。
・リストIDは合致するものは無し。
・小さい順に左から。
・1時間以内。

マクロ作成内容。
前提：手動で並べ替えておく。

電話番号、名前でまとめる。
複数ある場合は、左からリスト1、2、3、と並べる。

検証：INPUT、OUTPUTの数をチェック。ランダムでデータ検証。
※時間が無いので。

こちらのページは、仕事で頼まれた案件を忘れないように記載している、自分用のEXCELマクロです。自己流の実際に作成したマクロですので参考、コピペ、流用は構いませんが、動作等は責任は持てませんので了承ください。Dim等の宣言は別にあるので、そちらを参照してください。自分ようなのでサンプルはありません。

以下マクロ

    MSG_FLG = MsgBox("いも実行ＯＫ？", vbYesNo)
    If MSG_FLG = vbNo Then
       Exit Sub
    End If

    mySheetName001 = "INPUT"
    mySheetName002 = "OUTPUT"

'  ***クリア処理***
   '### シートフィルタ解除サブプロシジー ###
    sheet_clear

   '#### データクリア
    
    Sheets(mySheetName002).Select
    Worksheets(mySheetName002).Cells.Clear
    
'    Range("A:B,D:E,G:J").Select
'    Selection.NumberFormatLocal = "@"
    
    Range("A1").Select
    
    
    
    CNT01 = 0
    Set set_data01 = Worksheets(mySheetName001).Range("B4")
    Set set_data02 = Worksheets(mySheetName002).Range("B1")
      '### head
	set_data02.Offset(0, -1).value = "出荷予定日"
	set_data02.Offset(0, 0).value = "電話番号"
	set_data02.Offset(0, 1).value = "先名(漢字)"
	set_data02.Offset(0, 2).value = "郵便番号"
	set_data02.Offset(0, 3).value = "先住所"
	set_data02.Offset(0, 4).value = "依頼主電話番号"
	set_data02.Offset(0, 5).value = "依頼主名（漢字）"
	set_data02.Offset(0, 6).value = "依頼主郵便番号"
	set_data02.Offset(0, 7).value = "依頼主住所"
	set_data02.Offset(0, 8).value = "お客様管理番号"
	set_data02.Offset(0, 9).value = "商品名"
	set_data02.Offset(0, 10).value = "数量"
	set_data02.Offset(0, 11).value = "リスト1"
	set_data02.Offset(0, 12).value = "リスト2"
	set_data02.Offset(0, 13).value = "リスト3"
	set_data02.Offset(0, 14).value = "リスト4"
	set_data02.Offset(0, 15).value = "リスト5"
	set_data02.Offset(0, 16).value = "リスト6"
	set_data02.Offset(0, 17).value = "リスト7"
	set_data02.Offset(0, 18).value = "リスト8"
	set_data02.Offset(0, 19).value = "リスト9"
	set_data02.Offset(0, 20).value = "リスト10"
      
'   Set set_data02 = Worksheets(mySheetName002).Range("B2")
    CNT01 = 1
    Do Until set_data01.Offset(0, 0).value = ""
      
       If WORK01 <> (set_data01.Offset(0, 0).value & set_data01.Offset(0, 1).value) Then
          
          CNT01 = 1
          Set set_data02 = set_data02.Offset(1, 0)
          
          set_data02.Offset(0, 0).value = set_data01.Offset(0, 0).value
          set_data02.Offset(0, 1).value = set_data01.Offset(0, 1).value
          set_data02.Offset(0, 2).value = set_data01.Offset(0, 2).value
          set_data02.Offset(0, 3).value = set_data01.Offset(0, 3).value
          set_data02.Offset(0, 4).value = set_data01.Offset(0, 4).value
          set_data02.Offset(0, 5).value = set_data01.Offset(0, 5).value
          set_data02.Offset(0, 6).value = set_data01.Offset(0, 6).value
          set_data02.Offset(0, 7).value = set_data01.Offset(0, 7).value
          set_data02.Offset(0, 8).value = set_data01.Offset(0, 8).value
          set_data02.Offset(0, 9).value = set_data01.Offset(0, 9).value
          set_data02.Offset(0, 10).value = set_data01.Offset(0, 10).value
       
          set_data02.Offset(0, 10 + CNT01).value = set_data01.Offset(0, 11).value
       
          WORK01 = (set_data01.Offset(0, 0).value & set_data01.Offset(0, 1).value)
       
       Else   '### 同じコード
          CNT01 = CNT01 + 1
          set_data02.Offset(0, 10 + CNT01).value = set_data01.Offset(0, 11).value
       End If
        
       Set set_data01 = set_data01.Offset(1, 0)
    Loop
    
    Sheets(mySheetName002).Select
    Range("A1").Select
    
    Application.StatusBar = "処理件数 >" & CNT01 & " 件(END)"
    MSG_FLG = MsgBox(" 処理END(^^) ")