エクセル 複数セルの並べ替えをVBAで楽にしたい

質問

どなたか知識のある方がいらっしゃいましたら助けてください。

やりたい事は以下の２つです。
・部品数量が複数（２以上）あるデータを数量１に変更して、その個数分横に並べたい
・数量が１でそろったデータを単価の高い順に並び替えしたい

仕事の中で取引先からのデータを集計しているのですが、10000行くらいあるデータを手作業で変換していて非常に時間がかかって困っています。
データの内容は「部品番号／部品名／数量／単価」が１セットで4つのセルに入力されています。

取引先からのデータは数量が実数量で1だったり2だったりまちまちなのですが、こちらで管理する場合には部品数量を全て１に統一し、複数個あるデータはその個数分同じデータを横並びにしたいです。

（例）　※（部品番号／部品名／数量／単価）
【元々のデータ】
AAA/SCREW/２/\50　・・・・・

【変換後】
AAA/SCREW/1/\50 AAA/SCREW/1/\50

ちなみに、部品データは1行に最大30個入力（1セット4つのセルなので、合計120のセル）されています。

また、その数量を1に統一した後、今度はそれらのデータを部品単価の高い順に左から並び替えをしたいです。複数セルをセットで並び替えしないといけないので手作業でやっていて非常に時間がかかっています。

（例）　※（部品番号／部品名／数量／単価）
【元々のデータ】
AAA/SCREW/1/\50　BBB/CABLE/1/\100 CCC/SHAFT/1/\90 ・・・・・

【変換後】
BBB/CABLE/1/\100 CCC/SHAFT/1/\90 AAA/SCREW/1/\50 ・・・・・

先月同じ質問を出して数名の方から色々アドバイスを頂いたり参考となるデータを頂いたりしたのですが解決できなかったため今回もう一度出させて頂いております。
このデータ変更だけで数時間かかっているのでどうしても自動でエクセルにやらせたいのです・・・（泣）

ちなみに私はVBAがほとんど分からず、マクロにやることをレコードして少しずつ変更しているようなレベルです。

宜しくお願いいたします。

回答No.3

keithin · ベストアンサー

では遅いですが簡単なマクロで。

Sub Macro1()

　Dim r As Long
　Dim c As Long
　Dim n As Long
　Dim w As Worksheet
　Dim wx As Worksheet

’準備
　Set w = ActiveSheet
　Set wx = Worksheets.Add(before:=w)

’１行ずつ
　For r = 2 To w.Range("A65536").End(xlUp).Row
　　wx.Cells.ClearContents

　’転記する
　　For c = 1 To w.Range("IV" & r).End(xlToLeft).Column Step 4
　　　w.Cells(r, c).Resize(1, 4).Copy
　　　For n = 1 To w.Cells(r, c + 2)
　　　　wx.Range("A65536").End(xlUp).Offset(1).PasteSpecial
　　　Next n
　　Next c

　’降順に並べ替える
　　n = wx.Range("A65536").End(xlUp).Row
　　wx.Range("A2:D" & n).Sort key1:=wx.Range("D2"), order1:=xlDescending, header:=xlNo
　　wx.Range("C2:C" & n) = 1

　’転記する
　　For c = 2 To wx.Range("A65536").End(xlUp).Row
　　　wx.Cells(c, "A").Resize(1, 4).Copy w.Cells(r, (c - 2) * 4 + 1)
　　Next c
　Next r

’片づける
　Application.DisplayAlerts = False
　wx.Delete
　Application.DisplayAlerts = True
End Sub

目的のシートを開いてマクロを実行する。

お礼

できました、これです！！！！
これで簡単なんですか？すごいですね。
本当にありがとうございました。これでかなり時間を短縮することができます。

私もいつかはこんなマクロをちょろっと組めるようになりたいです。

回答No.2

KURUMITO

回答No1です。単価の体ものを上に並べるのでしたね。
それでしたらシート1でA列からD列までを選択してから「ホーム」タブの「並べ替え」をクリックして「ユーザー設定の並べ替え」を選択します。
最優先されるキーにはD1セルの文字を選択し、順序を「降順」にしてOKすればよいでしょう。
その他の操作は回答1のとおりです。

お礼

並び替えしましたが行が変わってしまいます。
同じ行の中で並び替えしたかったです。
が、これもまたひとついい勉強になりました。ありがとうございます。

回答No.1

KURUMITO

マクロですることのメリットはほとんどないでしょう。関数で十分に対応できます。
例えばシート1のAからD列で2行目から下方にデータが並んでいるとします。
シート2の2行目からお求めの表を作成するとしてA2セルには次の式を入力して120列（DP2)まで右横にドラッグコピーします。

=IF(OR(ROW(A1)>COUNTA(Sheet1!$A$2:$A$12000),COLUMN(A1)>INDEX(Sheet1!$C:$C,ROW(A2))*4),"",IF(MOD(COLUMN(A1)-1,4)+1<>3,INDEX(Sheet1!$A:$D,ROW(A2),MOD(COLUMN(A1)-1,4)+1),1))

そのドラッグした範囲を選択してから右クリックしてコピーします。
名前ボックスにはA2と表示されていることでしょうが、その窓を書き変えてA2:DP12000のようにします。確定すればその範囲が選択されますのでA2セルの場所で右クリックして「貼り付け」を行います。
これで操作は終了です。

お礼

早速のご回答ありがとうございます。
教えていただいた方法でやってみて、Sheet1のA-DにあるデータでCの数が2以上のものはSheet2のEから後にその差数分出てくるのですが、その後のデータ(Sheet1のE以降）のデータが出てきません。また、Sheet1のCが1のものもE以降のデータが出てきません・・・

難しいですね、この関数も私にとっては・・・