無料VBA講座

Sub 重複削除( )

　　Range("B3 : B18") .Select
　　ActiveSheet .Range("$B$3 : $B$16") .RemoveDuplicates Colmns := 1
　　　　　' 選択範囲1列目の重複データを削除する。

　　Range("B3 : B18") .Select
　　ActiveWorkbook .Worksheets("Sheet1") .Sort .SortFields .Clear
　　ActiveWorkbook .Worksheets("Sheet1") .Sort .SortFields .Add2 Key := Range("B3 : B16") _
　　　　, SortOn :=xlSortOnValues ,Order :=xlAscending ,CustomOrder := _
　　　　"NK-1,NK-2,NK-3,NK-4,NK-5,NK-6,NK-7,NK-8,NK-9,NK-10,NK-11,NK-12, _
　　　　DataOption := xlSortNomal
　　With ActiveWorkbook .Worksheets("Sheet1") .Sort
　　　　.SetRange Range("B3 : B18")
　　　　.Header = xlGuess
　　　　.MatchCase = False
　　　　.Orientation = xlTopBottm
　　　　.SortMethod = xlPinYin
　　　　.Apply
　　End With
　　　　　' B3からB18までをNK-1からNK-12の設定を使用してソートする。
　　　　　' この部分はマクロ記録でもできます。

　　Range("A1") .Select
End Sub

開いた[ユーザー設定リスト]の
[リストの項目]にNK-1からNK-12
くらいまで入力して、[追加]をクリック
する。すると左の[ユーザー設定リスト]
に記入される。[OK]を押す。

(注意)　リスト項目に、NK-1からNK-11
　　　　までは入力しないと、正常に
　　　　判断されない。

昇順に並べ替えると左の表の様になる。数値の順に並んでいないので見にくいと思う時には、右の表の様に
並べ替えをするための設定が必要になる。

並べ替えのユーザー設定

重複している製番は無くなったのだから、このままでも次の作業に差支えが無ければ良いが、
製番全体が把握できないと思う時には、昇順に並べ替えをする必要がある。

それでは、右の表を昇順に並べ替えてみよう。

データベースから、製番別の仕入データ等を集計したい時、製番に何と何があるのかわからない場合がある。
毎日新しい製番が作成されるので当然である。このような時は、データベースの製番部分をすべて取得して、
重複しているものを削除するのも一つの方法である。

左の表は、シート内に取得した製番がB3からB18に並んでいる。
右の表は、その中から重複しているデータを削除したものである。