📘 Excel逆引き事典

【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.
シート名や列番号が正しいか確認してください。