VBAのIE制御

今回は、セルの重複データを削除するサブルーチンを解説していきます。
VBAのIE制御では、あるサイトの一覧を取得するなど自動化できるので非常に便利ですが、細かな条件を付けない限りデータの選別は難しいです。
例えば、あるECサイトの商品情報を抽出する場合、一覧ページからまず商品詳細ページのURLを抽出しますが、一般的なECサイトは画像と商品名に同じリンクが貼られています。
画像のリンクとテキストのリンクに条件を付けてどちらか一方のリンクだけを抽出すれば重複データの抽出を回避できますが、カテゴリ毎に分かれた場合は対処しようがありません。
こちらも例にあげると「パソコン本体」というカテゴリにA商品があったとします。
A商品は「パソコン本体」カテゴリだけでなく「SONY」カテゴリにも存在した場合、重複データの回避は非常に難しくなります。
もちろん細かい条件を付ければ回避することはできますが、それより一旦全部のデータを抽出してから重複データを削除した方がより効率的です。

今回は、その重複データを削除するサブルーチンの制御方法について解説していきます。

まず、よく見かける重複データ削除のソースを見てましょう。

よくある重複データ削除のマクロ

Sub Sample1()
　Dim i As Long
　With Range("A2")
　　For i = .CurrentRegion.Rows.Count To 1 Step -1
　　　If .Offset(i, 0) = .Offset(i - 1, 0) Then .Offset(i, 0).EntireRow.Delete
　　Next i
　End With
End Sub

※ドラッグ(スワイプ)すると全体を確認できます。

Sub Sample2()

　Dim i As Double, j As Double   
　i = 1

　Do Until Cells(i, 1) = ""
　　j = i + 1

　　Do Until Cells(j, 1) = ""
　　　If Cells(i, 1) = Cells(j, 1) Then
　　　　Rows(j).Delete
　　　　　j = j - 1 
　　　End If
　　　j = j + 1  
　　Loop

　　i = i + 1
　Loop
End Sub

※ドラッグ(スワイプ)すると全体を確認できます。

こちらの処理がどのようなことをしているかというと以下のようになります。

Sample1の場合

Sample2の場合

処理の内容を見ると重複データがあった場合は行を削除するといった内容でほぼ一緒ですね。
もちろんこちらの処理でも問題ありませんが、データ数が多い場合は、処理時間がかかるのであまり効率的とはいえません。ちなみに50000行処理した場合、850秒かかりました。
分に換算すると約15分です。

ちょっとかかりすぎですね。そこで今回はもっと効率よく削除できる制御方法について、解説していきます。
まずは、処理の流れを見ていきましょう。

処理の流れを見ると処理内容が多いので、もっと時間がかかるのではないかと思われる方もいらっしゃると思いますが、こちらで50000行処理した場合、たった15秒で処理が完了しました。
前者の処理に比べると1/57まで短縮できたことになります。
理由としては、前者が1つ1つ行を削除しているのに対して、後者では削除行をまとめて削除している点です。
それでは、処理の内容が理解できたところで、実際のサブルーチンを見ていきましょう。

セルの重複データを削除するサブルーチン

Sub duplicateDataDel(Optional sheetName As String = "mySheet", _
　　　　　 　　　　　Optional col As Variant = "A")
　　　　　 
  Dim r As Long, i As Long, ChkCol As Long
  
  ChkCol = Columns.Count    '最終列取得
　　　　　 
　If sheetName = "mySheet" Then: sheetName = ActiveSheet.Name

　r = maxRC(sheetName, col)

　For i = 1 To r
　
　　Cells(i, ChkCol) = i
　
　Next i

　Cells.Sort Key1:=Range(col & "2"), Order1:=xlAscending, Header:=xlNo
　　　　   
　i = 1
　　　　   
　Do
　
　　If Cells(i, col) = Cells(i + 1, col) Then
　　
　　　Cells(i, ChkCol) = ""
　　
　　End If
　　
　　i = i + 1

　Loop Until Cells(i, col) = ""
　　　　   
　Cells.Sort Key1:=Cells(2, ChkCol), Order1:=xlAscending, Header:=xlNo
　　　　   
　r = maxRC(, ChkCol, 1)
　Range(r & ":" & Rows.Count).Select

　Selection.Delete Shift:=xlUp

　Columns(ChkCol).Clear

End Sub

※ドラッグ(スワイプ)すると全体を確認できます。

セルの重複データを削除するマクロ

Sub sample()
　 
　Call duplicateDataDel(, "B")

End Sub

※ドラッグ(スワイプ)すると全体を確認できます。

こちらの引数は以下の2つです。

引数すべてが任意項目となります。

「sheetName」には、ファイル名を入力するシート名文字列を入力します。
初期値は開いているシート名となります。

「col」には、チェック列の文字列を入力します。A列をチェックする場合は「A」を指定してください。
初期値は「A」が設定されています。

ChkCol = Columns.Count

※ドラッグ(スワイプ)すると全体を確認できます。

こちらはエクセルの列の数を取得しています。列の数＝最終列の番号になります。

If sheetName = "mySheet" Then: sheetName = ActiveSheet.Name

※ドラッグ(スワイプ)すると全体を確認できます。

こちらでは、シート名の初期値を設定しています。
引数を指定している場合は、そちらが利用されます。

r = maxRC(sheetName, col)

※ドラッグ(スワイプ)すると全体を確認できます。

最終行取得の「maxRCサブルーチン」を利用してチェック対象の最終行を取得します。

For i = 1 To r
　
　Cells(i, ChkCol) = i
　
Next i

※ドラッグ(スワイプ)すると全体を確認できます。

チェック行数分だけ連番を入力していきます。
こちらの連番はデータをソートするために利用されます。

Cells.Sort Key1:=Range(col & "2"), Order1:=xlAscending, Header:=xlNo

※ドラッグ(スワイプ)すると全体を確認できます。

すべてのセルを対象に最優先されるキーを削除チェック列に設定し、昇順で並び替えを行っています。

i = 1
　　　　   
Do
　
　If Cells(i, col) = Cells(i + 1, col) Then
　
　　Cells(i, ChkCol) = ""
　　
　End If
　　
　i = i + 1

Loop Until Cells(i, col) = ""

※ドラッグ(スワイプ)すると全体を確認できます。

こちらでは、「Do～Loopステートメント」を利用して該当セルと該当セルの1つ下のセルが同じ値の場合、最終列の該当行を空白にしています。
この空白になった行が削除行となります。

Cells.Sort Key1:=Cells(2, ChkCol), Order1:=xlAscending, Header:=xlNo

※ドラッグ(スワイプ)すると全体を確認できます。

すべてのセルを対象に最優先されるキーを最終列に設定し、昇順で並び替えを行っています。

r = maxRC(, ChkCol, 1)

※ドラッグ(スワイプ)すると全体を確認できます。

最終行取得の「maxRCサブルーチン」を利用して最終列の最終行に+1した行を取得しています。
これは削除行の最初の行になります。

Range(r & ":" & Rows.Count).Select

※ドラッグ(スワイプ)すると全体を確認できます。

こちらでは、削除対象の行をすべて選択しています。

Selection.Delete Shift:=xlUp

※ドラッグ(スワイプ)すると全体を確認できます。

削除対象の行をすべて選択したら、選択行を削除します。

Columns(ChkCol).Clear

※ドラッグ(スワイプ)すると全体を確認できます。

最後に最終列をクリアにして完了となります。