VBA100本ノック 17本目：重複削除（ユニーク化）
重複を削除してユニーク化（一意化）する問題です。
社員データから、部・課マスタを作成します。
ツイートでの見やすさを考慮して、ブック・シート指定等を適宜省略しています。
マクロVBAを初心者向けの基本から上級者向けの高度な内容までサンプルコードを掲載し解説しています。エクセル関数・機能・基本操作の入門解説からマクロVBAまでエクセル全般を網羅しています。
出題
出題ツイートへのリンク
#VBA100本ノック 17本目
画像1のように部・課・氏名の「社員」シートがあります。
このデータを基に、画像2のように部・課マスタを作成してください。
※部・課でユニーク化するという事ことです。
シート「部・課マスタ」は存在している前提で構いません。
※マスタなのでコード順にしてください。
サンプルファイルです。
https://excel-ubara.com/vba100sample/VBA100_17.xlsm
https://excel-ubara.com/vba100sample/VBA100_17.zip
画像1のように部・課・氏名の「社員」シートがあります。
このデータを基に、画像2のように部・課マスタを作成してください。
※部・課でユニーク化するという事ことです。
シート「部・課マスタ」は存在している前提で構いません。
※マスタなのでコード順にしてください。
https://excel-ubara.com/vba100sample/VBA100_17.xlsm
https://excel-ubara.com/vba100sample/VBA100_17.zip
VBA作成タイム
この下に頂いた回答へのリンクと解説を掲載しています。
途中まででも良いので、できるだけ自分でVBAを書いてみましょう。
他の人の回答および解説を見て、書いたVBAを見直してみましょう。
頂いた回答
解説
ユニーク化する方法は沢山あります。
・関数+（オートフィルター/1行ずつ抽出）
・並べ替えて上下比較
・Dictionaryを使う
・フィルターオプションの設定
・重複の削除
・ピボットテーブル
・Power Query
・UNIQUE関数
色々あますが、まずはフィルターオプションの設定から。
フィルターオプションの設定は、あくまでユニーク化にも使えるということであって、
何十万件から重複データを消すというような場合はお勧めしません。
次にユニーク化と言ったらDictionaryが思い浮かんだ人も多いのではないでしょうか。
Dictionaryは用途が広く、使い慣れると何かと便利です。
その他、関数+フィルター、並べ替えてから上下比較の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のSortは古い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行ずつコピーしていく方法になります。
この方法は寄せられた回答にありますので、ここでは割愛します。
上では関数をセルに入れて判定してところを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を書くのに困ることは無いと思います。
少なくとも、Excel2016まではバグ報告があるようですので、どうしても使う場合は注意してください。
特にデータ件数・列数が多かったり、列データに数値・文字が混在していたりする場合は要注意です。
VBAは、マクロ記録すればほぼそのまま使えるので、もし使うとしてもVBAを書くのに困ることは無いと思います。
ピボットテーブル
Power Query
VBAの今回のお題には向かないと思います。
VBAで新規にピボットを作るのが大変です。
事前にシートに作成しておけば、データの更新だけなので簡単です。
VBAで新規にピボットを作るのが大変です。
事前にシートに作成しておけば、データの更新だけなので簡単です。
このお題では他に簡単な方法があるので少々面倒な気がしますので割愛します。
UNIQUE関数
これが使えるなら（現時点で365なら）、これが最も簡単です。
サイト内関連ページ
第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 ・・・新着記事一覧を見る
ハイフン区切り文字列の『最初』と『最後』を抽出・結合｜エクセル練習問題(2026-02-23)
AIは便利なはずなのに…「AI疲れ」が次の社会問題になる｜生成AI活用研究(2026-02-16)
カンマ区切りデータの行展開｜エクセル練習問題(2026-01-28)
開いている「Excel/Word/PowerPoint」ファイルのパスを調べる方法｜エクセル雑感(2026-01-27)
IMPORTCSV関数（CSVファイルのインポート）｜エクセル入門(2026-01-19)
IMPORTTEXT関数（テキストファイルのインポート）｜エクセル入門(2026-01-19)
料金表（マトリックス）から金額で商品を特定する｜エクセル練習問題(2026-01-14)
「緩衝材」としてのVBAとRPA｜その終焉とAIの台頭｜エクセル雑感(2026-01-13)
シンギュラリティ前夜：AIは機械語へ回帰するのか｜生成AI活用研究(2026-01-08)
電卓とプログラムと私｜エクセル雑感(2025-12-30)
アクセスランキング ・・・ ランキング一覧を見る
1.最終行の取得（End,Rows.Count）｜VBA入門
2.日本の祝日一覧｜Excelリファレンス
3.変数宣言のDimとデータ型｜VBA入門
4.FILTER関数（範囲をフィルター処理）｜エクセル入門
5.RangeとCellsの使い方｜VBA入門
6.繰り返し処理（For Next)｜VBA入門
7.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
8.マクロとは？VBAとは？VBAでできること｜VBA入門
9.セルのクリア（Clear,ClearContents）｜VBA入門
10.メッセージボックス(MsgBox関数)｜VBA入門
- ホーム
- マクロVBA入門編
- VBA100本ノック
- 17本目：重複削除（ユニーク化）
このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
記述には細心の注意をしたつもりですが、間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。
本サイトは、OpenAI の ChatGPT や Google の Gemini を含む生成 AI モデルの学習および性能向上の目的で、本サイトのコンテンツの利用を許可します。
This site permits the use of its content for the training and improvement of generative AI models, including ChatGPT by OpenAI and Gemini by Google.