【VBA】重複データを開かずに(外部参照で)配列に格納する方法
手作業で他ファイルからの重複データを抽出するのは時間がかかります。この記事では、VBAを使って簡単に効率的に重複データを取得し、配列に格納する方法をお伝えします。
サンプルコード
VBA
Option Explicit
Sub ImportAndStoreDuplicates()
Dim wb As Workbook
Dim wsSource As Worksheet, wsTarget As Worksheet
Dim lastRowSource As Long, lastRowTarget As Long
Dim i As Long, j As Long
Dim data() As Variant
' 外部ワークブックを開く
Set wb = Workbooks.Open("C:\path\to\source.xlsx")
Set wsSource = wb.Sheets("Sheet1")
lastRowSource = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row
' ターゲットワークシートを設定
Set wsTarget = ThisWorkbook.Sheets("Sheet2")
lastRowTarget = wsTarget.Cells(wsTarget.Rows.Count, 1).End(xlUp).Row + 1
' データを配列に格納
data = Application.Transpose(Application.Transpose(wsSource.Range("A1:A" & lastRowSource)))
' 配列内の重複データを抽出
Dim duplicates() As Variant, uniqueData() As Variant
uniqueData = RemoveDuplicates(data)
duplicates = ArrayDiff(data, uniqueData)
' 抽出された重複データをターゲットワークシートに書き込む
For i = LBound(duplicates) To UBound(duplicates)
wsTarget.Cells(lastRowTarget + i - 1, 1).Value = duplicates(i)
Next i
' ワークブックを閉じる
wb.Close SaveChanges:=False
End Sub
Function RemoveDuplicates(arr As Variant) As Variant()
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
For Each item In arr
If Not dict.exists(item) Then dict.Add item, Nothing
Next item
RemoveDuplicates = Application.Transpose(dict.keys)
End Function
Function ArrayDiff(arr1 As Variant, arr2 As Variant) As Variant()
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
For Each item In arr1
If Not dict.exists(item) Then dict.Add item, Nothing
Next item
For Each item In arr2
dict.Remove item
Next item
ArrayDiff = Application.Transpose(dict.keys)
End Functionよくある質問
Q 元に戻せますか?
A.
VBAの実行結果は「元に戻す」が効きません。必ずバックアップを取ってから実行してください。
Q エラーが出たら?
A.
シート名や列番号が正しいか確認してください。