こんにちは！ 健史です。
大量の行のExcelデータから例えば「B列の項目が重複しているデータを探したい！」ということありませんか。
100行位のExcelデータであっても目視で探すのはたいへんです。
Excelの「COUNTIF 関数」を使えばできますが、Excel-VBA 実例 重複チェックして重複データを抽出するとは別のロジックで処理するプログラムを作成してみました。
「プログラムだけを早く使いたい！」という方は、ココをクリックすればページ内のプログラムに飛びます。
ただし、お手持ちのデータで実行する場合は、データに合わせ重複チェックしたい列で並べ替え(ソート)し、重複チェック列と重複データにマーキング('1'をセット)する列を変える必要があります。
重複データにマーキング('1'をセット)する列は、データがない、空白の列を指定します。誤ってデータのある列を指定すると該当のデータに'1'がセットされ消えますのでご注意下さい。
尚この記事は、Excel-VBAを起動して貼り付ければ動作することを目指しています。
Excel-VBAの構造、起動方法、実行方法などを理解されていない方は、以下の記事を参照しながら一度やってみてから対応されることをお勧めします。
実行中に発生したエラーの対処法は、上記記事の2.エラーが発生したときの対処法に記載しています。(この段落のリンクから直接遷移します)
プログラムの概要
今回のサンプルプログラムは
イメージは以下です。
重複チェックする「2行目と3行目」、「3行目と4行目」のB列の値を比較して、同じ場合には両方の行のC列に'1'をセットするプログラムです。
ですから、実行前には必ず重複チェックする列で並べ替え(ソート)しておくことが必要で、ソートされて並べ替えされていないと正確に処理できません。
1.入力
B列に重複しているデータがあるExcelシートです。
2.実行結果
重複しているデータはC列に'1'が入っています。
プログラムの作成と実行
シンプル版のプログラム
1.Excelを起動
1).対象となるデータ入力
「プログラムの概要」の入力データを後述「サンプルデータ」から貼り付けます。B列でソート済みです。
ドラッグ＆コピー後にExcelに貼り付けるとき、[形式を選択して貼り付ける]-[テキスト]で貼り付けます。(セル[A1]で[右クリック]、[形式を選択して貼り付ける]-[テキスト])
お手持ちのデータの場合は、必ずExcelの機能「並べ替え」にて重複チェックする列で並べ替え(ソート)しておく必要があります。
2.Excel-VBAを起動
Altを押した状態でF8キーを押します。
4.[マクロ名(M):]に'test'と入力(''は不要、''内のtestを入力)
5.[作成(C)]をクリック
6.以下のプログラムをドラッグ＆コピー
Dim ix1 As Long
For ix1 = 2 To Sheets(1).Range("B1").End(xlDown).Row - 1
If Sheets(1).Cells(ix1, 2) = Sheets(1).Cells(ix1 + 1, 2) Then
Sheets(1).Cells(ix1, 3) = "1"
Sheets(1).Cells(ix1 + 1, 3) = "1"
End If
Next
7.以下に貼り付け(ペースト)
Sub test()
ここに貼り付ける
End Sub
8.F5キーで実行
9.実行結果の確認
重複している全データのC列に'1'が入っています。
イメージは上記プログラムの概要の[2.実行結果]です。
汎用性を考慮したプログラム
まず実行結果から
以下コメント入りのプログラムですが、上記シンプル版のプログラムに機能追加した内容であり上記の詳細説明も兼ねています。
概要は以下の通りです。
・並べ替え(ソート)の機能を追加
・ソート＆重複チェックする列、'1'をセットする列を変数として、変更すれば処理ロジック内の修正を不要とした
・重複した1件目には'1'、2件目には'2'、3件目には'3'・・・とセットする
・値をセットする列をクリアし、かつ、見出し('重複')をセット
・シンプル版のプログラムで重複チェック列を指定する[Range("B1")]を[Cells(1, key1)]に変更
'①修正 ソート＆重複チェックするする列を指定
Const key1 As Long = 2 'B列
'②修正 重複のチェックを入れる列を数字で指定
Const Check_iy1 As Long = 3 'C列
'添え字：ix1を定義
Dim ix1 As Long
iy1 = Check_iy1
'重複チェック欄をクリアして見出しを付ける
Sheets(1).Columns(Check_iy1).Clear
Sheets(1).Cells(1, Check_iy1) = "重複"
'重複チェックする項目でソート
Sheets(1).UsedRange.Sort _
key1:=Sheets(1).Cells(1, key1), Order1:=xlAscending, _
Header:=xlYes
'重複のチェックを入れる列をゼロクリア
For ix1 = 2 To Sheets(1).Cells(1, key1).End(xlDown).Row
Sheets(1).Cells(ix1, 3) = 0
Next
'重複チェック
For ix1 = 2 To Sheets(1).Cells(1, key1).End(xlDown).Row - 1
If Sheets(1).Cells(ix1, key1) = Sheets(1).Cells(ix1 + 1, key1) Then
If Sheets(1).Cells(ix1, Check_iy1) = 0 Then
Sheets(1).Cells(ix1, Check_iy1) = Sheets(1).Cells(ix1, Check_iy1) + 1
End If
Sheets(1).Cells(ix1 + 1, Check_iy1) = Sheets(1).Cells(ix1, Check_iy1) + 1
End If
Next
'重複のチェックを入れる列がゼロを空白にする
For ix1 = 2 To Sheets(1).Cells(1, key1).End(xlDown).Row
If Sheets(1).Cells(ix1, Check_iy1) = 0 Then
Sheets(1).Cells(ix1, Check_iy1) = ""
End If
Next
「重複チェックする項目はB列だけですが、結果を確認するときはB列が重複しているデータの中ではA列の並びを昇順でみたい」場合は、
'①修正 ソートする列を指定
Const key1 As Long = 2 'B列
Const key2 As Long = 1 'A列
-----省略-----
'重複チェックする項目でソート
Sheets(1).UsedRange.Sort _
key1:=Sheets(1).Cells(1, key1), Order1:=xlAscending, _
key2:=Sheets(1).Cells(1, key2), Order2:=xlAscending, _
Header:=xlYes
-----省略-----
Next
と追加修正します。
このプログラムであれば例えば
・重複してるデータでA列[番号]の最も大きい・小さいデータを抽出したい
・重複している件数がもっとも大きいデータはどれ？
といったことに対応できます。
最後に
Excel-VBA 実例 重複チェックして重複データを抽出するで紹介したプログラムとは異なり、対象となる列でソートしてから行う処理です。
前記記事のプログラムは並べ替え(ソート)は不要ですが、2行目を固定して行の最後までを比較、次に3行目を固定して行の最後までを比較・・・と比較回数が多くなります。(1行目は項目名の行であるため2行目から)
この記事のプログラムは並べ替え(ソート)が必要ですが、2行目と3行目、3行目と4行目・・・・と比較していくので、比較回数は少なくなります。
おそらく、100万件近いデータを前記記事のプログラムで処理すると、1日では終わらと思います。
しかし、この記事のプログラムで処理すれば、そんなには時間は掛からないでしょう。
参考にして頂ければと思います。
サンプルデータ
番号 記号 A0001 C001 A0002 C002 A0003 C003 A0004 C004 A0005 C005 A0006 C005 A0007 C005 A0008 C005 A0009 C009 A0010 C010 A0011 C011 A0012 C012 A0013 C013 A0014 C014 A0015 C015 A0016 C016 A0017 C017 A0018 C017 A0019 C017 A0020 C020 A0021 C021 A0022 C022 A0023 C023 A0024 C024 A0025 C025
コメント