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

VBAを100本の練習問題で鍛えます
公開日:2020-11-05 最終更新日:2021-02-22

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


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


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

VBAテスト用のサンプルデータは、VBA100本ノックの目次ページ からもダウンロードできます。
マクロVBAを初心者向けの基本から上級者向けの高度な内容までサンプルコードを掲載し解説しています。エクセル関数・機能・基本操作の入門解説からマクロVBAまでエクセル全般を網羅しています。


出題

出題ツイートへのリンク

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

マクロ VBA 100本ノック

マクロ VBA 100本ノック


サンプルファイルです。
https://excel-ubara.com/vba100sample/VBA100_17.xlsm
https://excel-ubara.com/vba100sample/VBA100_17.zip


VBA作成タイム

この下に頂いた回答へのリンクと解説を掲載しています。
途中まででも良いので、できるだけ自分でVBAを書いてみましょう。


他の人の回答および解説を見て、書いたVBAを見直してみましょう。


頂いた回答

解説

ユニーク化する方法は沢山あります。
・関数+(オートフィルター/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入門
・Range.Sortメソッド・・・Excel2003までのソート ・2007以降の並べ替え ・Excel2003までのSortとExcel2007以降のSortの使い分け
第89回.オートフィルタ(AutoFilter)|VBA入門
・Range.AutoFilterメソッド ・AutoFilterModeプロパティ ・AutoFilterオブジェクト ・オートフィルタのVBA使用例 ・日付のフィルタ ・オートフィルタまとめ
第90回.フィルタオプションの設定(AdvancedFilter)|VBA入門
・フィルター詳細設定の使い方 ・Range.AdvancedFilter メソッド ・フィルターオプションの設定の関連記事
第93回.ピボットテーブル(PivotTable)|VBA入門
・ピボットテーブル(PivotTable)を構成するオブジェクト群 ・Excel2010のピボットテーブル(PivotTable)のマクロ記録 ・Excel2003のピボットテーブル(PivotTable)のマクロ記録 ・Excel2010とExcel2003のピボットテーブルVBAの違いについて ・ピボットテーブル(PivotTable)のマクロVBA実践例
第132回.その他のExcel機能(グループ化、重複の削除、オートフィル等)|VBA入門
・マクロの記録 ・グループ化 ・重複の削除 ・オートフィル ・連続データの作成 ・その他のExcel機能
重複削除しユニークデータ作成(フィルターオプションの設定)|エクセルの基本操作
エクセル作業においては、データの重複を排除して、ユニークなデータを作成する必要がある場合は多々あります。そのような時の操作として、以下の方法があります。・COUNTIF関数で重複を判定して削除 ・ピボットテーブルで重複を削除 ・重複の削除で重複を削除 ・フィルタの詳細設定(フィルターオプションの設定)で重複を削除 …




同じテーマ「VBA100本ノック」の記事

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


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

VBA10大躓きポイント(初心者が躓きやすいポイント)|VBA技術解説(2024-03-05)
テンキーのスクリーンキーボード作成|ユーザーフォーム入門(2024-02-26)
無効な前方参照か、コンパイルされていない種類への参照です。|エクセル雑感(2024-02-17)
初級脱出10問パック|VBA練習問題(2024-01-24)
累計を求める数式あれこれ|エクセル関数応用(2024-01-22)
複数の文字列を検索して置換するSUBSTITUTE|エクセル入門(2024-01-03)
いくつかの数式の計算中にリソース不足になりました。|エクセル雑感(2023-12-28)
VBAでクリップボードへ文字列を送信・取得する3つの方法|VBA技術解説(2023-12-07)
難しい数式とは何か?|エクセル雑感(2023-12-07)
スピらない スピル数式 スピらせる|エクセル雑感(2023-12-06)


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

1.最終行の取得(End,Rows.Count)|VBA入門
2.RangeとCellsの使い方|VBA入門
3.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
4.繰り返し処理(For Next)|VBA入門
5.変数宣言のDimとデータ型|VBA入門
6.ブックを閉じる・保存(Close,Save,SaveAs)|VBA入門
7.並べ替え(Sort)|VBA入門
8.条件分岐(IF)|VBA入門
9.セルのクリア(Clear,ClearContents)|VBA入門
10.マクロとは?VBAとは?VBAでできること|VBA入門




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


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



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