VBA練習問題
VBA100本ノック 17本目:重複削除(ユニーク化)

VBAを100本の練習問題で鍛えます
最終更新日:2020-11-07

VBA100本ノック 17本目:重複削除(ユニーク化)


重複を削除してユニーク化(一意化)する問題です。
社員データから、部・課マスタを作成します。


ツイッター連動企画です。
ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。


出題

出題ツイートへのリンク

#VBA100本ノック 17本目
画像1のように部・課・氏名の「社員」シートがあります。
このデータを基に、画像2のように部・課マスタを作成してください。
※部・課でユニーク化するという事ことです。
シート「部・課マスタ」は存在している前提で構いません。
※マスタなのでコード順にしてください。

マクロ VBA 100本ノック

マクロ VBA 100本ノック


頂いた回答

解説

ユニーク化する方法は沢山あります。
・関数+(オートフィルター/1行ずつ抽出)
・並べ替えて上下比較
・Dictionaryを使う
・フィルターオプションの設定
・重複の削除
・ピボットテーブル
・Power Query
・UNIQUE関数
色々あますが、まずはフィルターオプションの設定から。

Sub VBA100_17_01()
  Dim ws社員 As Worksheet
  Dim ws部課 As Worksheet
  Set ws社員 = Worksheets("社員")
  Set ws部課 = Worksheets("部・課マスタ")
  
  ws部課.Cells.Clear
  ws社員.Columns("C:F").AdvancedFilter Action:=xlFilterCopy, _
                     CopyToRange:=ws部課.Range("A1"), _
                     Unique:=True
  
  With ws部課
    .Range("A1").CurrentRegion.Sort key1:=.Range("A1"), order1:=xlAscending, _
                    key2:=.Range("B1"), order2:=xlAscending, _
                    Header:=xlYes
  End With
End Sub


フィルターオプションの設定は、あくまでユニーク化にも使えるということであって、
何十万件から重複データを消すというような場合はお勧めしません。
次にユニーク化と言ったらDictionaryが思い浮かんだ人も多いのではないでしょうか。
Dictionaryは用途が広く、使い慣れると何かと便利です。

Sub VBA100_17_02()
  Dim ws社員 As Worksheet
  Dim ws部課 As Worksheet
  Set ws社員 = Worksheets("社員")
  Set ws部課 = Worksheets("部・課マスタ")
  
  Dim dic As Object
  Set dic = CreateObject("Scripting.Dictionary")
  
  Dim i As Long, tmp As String
  With ws社員
    For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
      tmp = .Cells(i, 3) & vbTab & .Cells(i, 4)
      If Not dic.exists(tmp) Then
        dic.Add tmp, .Cells(i, 3).Resize(, 4).Value
      End If
    Next
  End With
  
  ws部課.Range("A1").CurrentRegion.Offset(1).ClearContents
  Dim j As Long, v As Variant
  j = 2
  For Each v In dic.items
    ws部課.Cells(j, 1).Resize(, 4).Value = v
    j = j + 1
  Next
  
  With ws部課
    .Range("A1").CurrentRegion.Sort key1:=.Range("A1"), order1:=xlAscending, _
                    key2:=.Range("B1"), order2:=xlAscending, _
                    Header:=xlYes
  End With
End Sub


その他、関数+フィルター、並べ替えてから上下比較のVBAサンプルを記事補足に掲載しました。
方法は沢山あるので、いろいろ挑戦してみると面白いと思います。


補足

先のVBAのSortは古いSortメソッドで記述しました。
以下では、シートのSortオブジェクトを使った記述にしています。

関数+オートフィルター
Sub VBA100_17_03()
  Dim ws社員 As Worksheet
  Dim ws部課 As Worksheet
  Set ws社員 = Worksheets("社員")
  Set ws部課 = Worksheets("部・課マスタ")
  
  ws部課.Cells.Clear
  ws社員.Range("G1").Value = "判定"
  With ws社員.Range("A1").CurrentRegion
    Intersect(.Cells, .Offset(1, 6)).Formula = "=COUNTIFS(C$2:C2,C2,D$2:D2,D2)"
    .AutoFilter field:=7, Criteria1:=1
    .Columns("C:F").Copy Destination:=ws部課.Range("A1")
    ws社員.AutoFilterMode = False
    .Columns(7).Delete
  End With
  
  With ws部課.Sort
    .SortFields.Clear
    .SortFields.Add Key:=ws部課.Range("A1"), Order:=xlAscending
    .SortFields.Add Key:=ws部課.Range("B1"), Order:=xlAscending
    .SetRange ws部課.Range("A1").CurrentRegion
    .Header = xlYes
    .Apply
  End With
End Sub

関数+1行ずつ抽出
For...Nextで1行ずつ判定していく方法になります。
上では関数をセルに入れて判定してところをVBAでWorksheetFunctionを使って判定し、判定結果で1行ずつコピーしていく方法になります。
この方法は寄せられた回答にありますので、ここでは割愛します。

並べ替えて上下比較
Sub VBA100_17_04()
  Dim ws社員 As Worksheet
  Dim ws部課 As Worksheet
  Set ws社員 = Worksheets("社員")
  Set ws部課 = Worksheets("部・課マスタ")
  
  ws部課.Cells.Clear
  ws社員.Columns("C:F").Copy Destination:=ws部課.Range("A1")
  
  With ws部課.Sort
    .SortFields.Clear
    .SortFields.Add Key:=ws部課.Range("A1"), Order:=xlAscending
    .SortFields.Add Key:=ws部課.Range("B1"), Order:=xlAscending
    .SetRange ws部課.Range("A1").CurrentRegion
    .Header = xlYes
    .Apply
  End With
  
  Dim i As Long
  With ws部課
    For i = .Cells(.Rows.Count, 1).End(xlUp).Row To 2 Step -1
      If .Cells(i, 1) = .Cells(i - 1, 1) And _
        .Cells(i, 2) = .Cells(i - 1, 2) Then
        .Rows(i).Delete
      End If
    Next
  End With
End Sub

対象となる列を全部コピーした後、
下行から上に向かって、上の行と同じなら行削除しています。
データ件数が多いと処理時間がかなりかかってしまうので、件数が多い場合は別の方法を検討してください。

重複の削除
簡単な方法ですが、当初からバグが報告されていて使うのを躊躇している人も多いと思います。
少なくとも、Excel2016まではバグ報告があるようですので、どうしても使う場合は注意してください。
特にデータ件数・列数が多かったり、列データに数値・文字が混在していたりする場合は要注意です。
VBAは、マクロ記録すればほぼそのまま使えるので、もし使うとしてもVBAを書くのに困ることは無いと思います。

ピボットテーブル
VBAの今回のお題には向かないと思います。
VBAで新規にピボットを作るのが大変です。
事前にシートに作成しておけば、データの更新だけなので簡単です。
マクロ VBA 100本ノック

Power Query
このお題では他に簡単な方法があるので少々面倒な気がしますので割愛します。

UNIQUE関数
これが使えるなら(現時点で365なら)、これが最も簡単です。

マクロ VBA 100本ノック


サイト内関連ページ

第88回.並べ替え(Sort)|VBA入門
並べ替えは、データ処理の基本中の基本です、乱雑なデータを並べ替えることは、データ処理の第一歩です。マクロVBAで並べ替えを実行するには、シート操作の「並べ替え」の機能を使用することになります。そもそもデータを並べ替えるという事は、そのデータのキーが何かを考えるという事です。
第89回.オートフィルタ(AutoFilter)|VBA入門
オートフィルタはExcelのデータベースとしての非常に強力な機能を提供してくれています、VBAで、必要なデータだけに絞り込んで他のシートにコピーしたり、不要なデータを一括で削除したりする場合は、とても高速に処理することができます。VBAでオートフィルタを操作するには、以下のメソッド・プロパティおよびオブジェクトを使用します。
第90回.フィルタオプションの設定(AdvancedFilter)|VBA入門
ワークシートの操作「フィルタオプションの設定」のVBAの記述になります、便利な機能ではありますが、そもそも、ワークシートの操作が難しいこともあり、あまり有効に使われていないように感じます。フィルタ詳細設定の使い方 「データ」タブ→「並べ替えとフィルター」グループの「詳細設定」この機能を使う場合のVBAになります。
第93回.ピボットテーブル(PivotTable)|VBA入門
ピボットテーブルをVBAで操作する事が良いかどうか、少々疑問な部分もあります。しかし、ピボットテーブル(PivotTable)はエクセルでは必須機能になりますので、少なくとも、ピボットテーブルの基本くらいは知っておくべきでしょう。今回はピボットテーブル(PivotTable)のオブシェクトをざっと見てから、
第132回.その他のExcel機能(グループ化、重複の削除、オートフィル等)|VBA入門
エセルの機能は豊富で、全部の機能を使っている人はまずいないでしょう、どのような機能があるかだけ知っていれば、必要な時に使えばそれで良いのです。マクロVBAでも全てのエクセル機能を覚える必要などありません、必要になった時に調べてVBAが書ければそれで充分です。
重複削除しユニークデータ作成(フィルターオプションの設定)|エクセルの基本操作
エクセル作業においては、データの重複を排除して、ユニークなデータを作成する必要がある場合は多々あります。そのような時の操作として、以下の方法があります。・COUNTIF関数で重複を判定して削除 ・ピボットテーブルで重複を削除 ・重複の削除で重複を削除 ・フィルタの詳細設定(フィルターオプションの設定)で重複を削除 どれも一長一短はありますが、




同じテーマ「Python入門」の記事

VBA100本ノック 14本目:社外秘シート削除
VBA100本ノック 15本目:シートの並べ替え
VBA100本ノック 16本目:無駄な改行を削除
VBA100本ノック 17本目:重複削除(ユニーク化)
VBA100本ノック 18本目:名前定義の削除
VBA100本ノック 19本目:図形のコピー
VBA100本ノック 20本目:ブックのバックアップ
VBA100本ノック 21本目:バックアップファイルの削除
VBA100本ノック 22本目:FizzBuzz発展問題
VBA100本ノック 23本目:シート構成の一致確認
VBA100本ノック 24本目:全角英数のみ半角


新着記事NEW ・・・新着記事一覧を見る

VBA100本ノック 34本目:配列の左右回転|VBA練習問題(11月28日)
VBA100本ノック 33本目:マクロ記録の改修|VBA練習問題(11月26日)
VBA100本ノック 32本目:Excel終了とテキストファイル出力|VBA練習問題(11月25日)
VBA100本ノック 31本目:入力規則|VBA練習問題(11月24日)
将棋とプログラミングについて~そこには型がある~|エクセル雑感(11月22日)
VBA100本ノック 30本目:名札作成(段組み)|VBA練習問題(11月22日)
VBA100本ノック 29本目:画像の挿入|VBA練習問題(11月21日)
VBA100本ノック 28本目:シートをブックに分割|VBA練習問題(11月19日)
VBA100本ノック 27本目:ハイパーリンクのURL|VBA練習問題(11月18日)
VBA100本ノック 26本目:ファイル一覧作成|VBA練習問題(11月17日)


アクセスランキング ・・・ ランキング一覧を見る

1.最終行の取得(End,Rows.Count)|VBA入門
2.RangeとCellsの使い方|VBA入門
3.変数宣言のDimとデータ型|VBA入門
4.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
5.マクロって何?VBAって何?|VBA入門
6.Range以外の指定方法(Cells,Rows,Columns)|VBA入門
7.繰り返し処理(For Next)|VBA入門
8.セルに文字を入れるとは(Range,Value)|VBA入門
9.とにかく書いてみよう(Sub,End Sub)|VBA入門
10.マクロはどこに書くの(VBEの起動)|VBA入門




このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。


記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。



このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
本文下部へ