[[20210920210052]]　『並べ替え』（ドラ）　ページの最後に飛ぶ

『並べ替え』（ドラ）

 同品番が複数あれば受注日より品番をまとめたいです。
下記の様に並べ替えを行うにはどのような方法がありますでしょうか？
宜しくお願いします。
 　　　並べ替え前  
  A列	          B列
 受注日	         品番
2021/09/17	1535270
2021/09/17	4870182
2021/09/17	4870184
2021/09/17	5156009
2021/09/17	5785869
2021/09/18	1535270
2021/09/20	2851329
2021/09/20	3237580
2021/09/20	4870184
2021/09/20	5156009
2021/09/20	5785869

　　　並べ替え後

           ↓
  A列	          B列
 受注日	         品番		 
2021/09/17	1535270
2021/09/18	1535270
2021/09/17	4870182
2021/09/17	4870184
2021/09/20	4870184
2021/09/17	5156009
2021/09/20	5156009
2021/09/17	5785869
2021/09/20	5785869
2021/09/20	2851329
2021/09/20	3237580

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

現在、A列の昇順になっているのであれば、
B列を昇順に並び替えれば、
同一品番で、受注日が逆転することはありません。

こういうソートを「安定ソート」と呼びますが、
Excelのソートは「安定ソート」であり、上記のことが保証されています。

# 心配なら、第一優先キーを品番、第二優先キーを受注日にしても
# もちろん問題ありません。
（γ） 2021/09/20(月) 21:09

 γさん
　早速のご返答ありがとうございます。
　説明不足で申し訳ございません。下記の様になるのは確認出来るのですが
同品番が複数あればまとめて次は受注日の古い物を優先したいです。

 受注日	         品番
2021/09/17	1535270
2021/09/18	1535270
2021/09/20	2851329
2021/09/20	3237580
2021/09/17	4870182
2021/09/17	4870184
2021/09/20	4870184
2021/09/17	5156009
2021/09/20	5156009
2021/09/17	5785869
2021/09/20	5785869

（ドラ） 2021/09/20(月) 21:48

どうなればいいのか示してください。

（γ） 2021/09/20(月) 21:56

＞どうなればいいのか示してください。
最初に示しているのだが？

（横入り失礼） 2021/09/20(月) 22:03

ちょっと分からない。他の方の回答を待って下さい。

（γ） 2021/09/20(月) 22:19

基本受注日順で、品番が複数あるものは最初の位置にまとめる
ということですか？
（namn） 2021/09/21(火) 08:38

 # 昨日は藤井・木村戦が気になってしまって失礼しました。

 改めて考えてみました。
 マクロを使っていますが、こんなことではどうですか？
 コピーを別シートのA1から書き込んで、以下のtestを実行してみて下さい。

 Sub test()
     Dim dic As Object
     Dim k&, p&
     Dim 品番$
     '元データは受注日の昇順でソートされているものとする。一行目は見出しあり。

     'ソート用のキーである、
     '「品番毎の連番 * 10 + 重複データ加算（品番が重複していたら1から順次加算）」を
     'C列にセット
     Set dic = CreateObject("Scripting.Dictionary")
     For k = 2 To Cells(Rows.Count, "A").End(xlUp).Row
         品番 = CStr(Cells(k, "B"))
         If Not dic.Exists(品番) Then
             p = p + 1
             dic(品番) = p * 10  '品番が重複するデータは最大でも10個とした
         Else
             dic(品番) = dic(品番) + 1
         End If
         Cells(k, "C") = dic(品番)
     Next

     'C列で昇順ソート
     [A1].CurrentRegion.Sort key1:=Range("C1"), _
                             Order1:=xlAscending, _
                             Header:=True
 End Sub

（γ） 2021/09/21(火) 09:07

 もちろんマクロが必須というわけでもありません。
 （私は式が苦手なので、コードを書くほうが負荷が少なかったというだけです）

 重複を排除した一意の品番セットを作成したうえで、
 MATCH関数とCOUNTIF関数を組みあわせれば、
 上記のソート用のキーは簡単に作成できます。
 実際のソートすら関数で書けるでしょうけど、
 ソートというツールを使ったほうがよいと思います。

（γ） 2021/09/21(火) 10:16

 C2 =IF(COUNTIF($B$2:B2,B2)=1,MAX($C$1:C1)+1,VLOOKUP(B2,$B$1:C1,2,FALSE))
 下コピー

 データ～並べ替え
「先頭行をデータの見出しとして使用する」にチェック

 C列をキーに昇順並べ替え

 少なくとも例示通りにはなります。

 以上
（笑） 2021/09/21(火) 13:10

横からですがnamnさんが読み解いた通りであって、VBAでもOKということであれば

 (1)受注日順に並んだ状態で、品番が出てくる順に【連想配列】で重複しないリストを得る
 (2)(1)のリスト順に【Sortオブジェクト】で並び替える

というアプローチでもよいかもしれません。

    Sub 別案()
        Dim MyDIC As Object
        Dim i As Long

        Set MyDIC = CreateObject("Scripting.Dictionary")

        On Error Resume Next
        For i = 2 To Cells(Rows.Count, "B").End(xlUp).Row
            MyDIC.Add Cells(i, "B").Value, ""
        Next i
        On Error GoTo 0

        With ActiveSheet.Sort
            .SortFields.Clear
            .SortFields.Add2 Key:=Range("B1"), Order:=xlAscending, CustomOrder:=Join(MyDIC.keys, ",")
            .SetRange Range("A1").CurrentRegion
            .Header = xlYes
            .Apply
        End With
    End Sub

Sortメソッドだと、γさんが示されたように作業列をつかうとか、「ユーザー設定リスト」に追加してから何番目か指定するなどの対策を行う必要がありますが、Sortオブジェクトであればコード中にそのまま書けるのが強みですね。
（その分コードはややこしくなっちゃいますが）

（もこな２） 2021/09/21(火) 13:44

　namnさん
分りにくい説明で申し訳ございません。そうです。

γさん、笑さん
やりたかった事が出来ました。ありがとうございました。

もこな２さん
「実行時エラー’438′:オブジェクトは、このプロパティまたはメソッドをサポートしていません。」と表示されるのですが？
（ドラ） 2021/09/21(火) 23:54

＞「実行時エラー’438′:オブジェクトは、このプロパティまたはメソッドをサポートしていません。」と表示されるのですが？
そうですか。私の環境（office365／Windows10）だと動作しますが、Excel2013だと何か対応してないのかもしれませんね。

今後の参考にしたいので、差し支えなければ、どこでエラーが発生していたか（エラー発生時にどこがハイライトされていたか）教えていただけないですか？

（もこな２） 2021/09/22(水) 02:50

もこな２さん
おはようございます。

.SortFields.Add2 Key:=Range("B1"), Order:=xlAscending, CustomOrder:=Join(MyDIC.keys, ",")

ここでエラーが発生します。宜しくお願いします。
（ドラ） 2021/09/22(水) 07:23

情報提供ありがとうございます。
もしかしたらですが

 .SortFields.Add2 Key:=Range("B1"), Order:=xlAscending, CustomOrder:=Join(MyDIC.keys, ",")
              ↓
 .SortFields.Add Key:=Range("B1"), Order:=xlAscending, CustomOrder:=Join(MyDIC.keys, ",")

とすればよいかもしれません。（あんまり自信ないですが）

（もこな２） 2021/09/22(水) 07:53

ちょっと調べてみました。やはり、「.Add2」が原因のようですね。
失礼しました。
http://officetanaka.net/excel/vba/tips/tips148.htm

（もこな２） 2021/09/22(水) 08:23

もこな２さん
出来ました。ありがとうございました😊
（ドラ） 2021/09/22(水) 16:49

コメント返信：

[ 一覧(最新更新順) ]

[[20210920210052]] 『並べ替え』（ドラ） ページの最後に飛ぶ

[[20210920210052]]　『並べ替え』（ドラ）　ページの最後に飛ぶ