ExcelのVBAでシート間の重複なしデータ転記を自動化する方法

こんにちは。今回は、ExcelのVBAを使って、あるシートから別のシートへデータを転記する際に、重複を自動的に除去する方法をご紹介します。

はじめに

Excelで作業をしていると、あるシートのデータを別のシートに転記したいけれど、重複は除きたいという場面によく遭遇します。今回は、「シートA」のA列とB列の組み合わせを取り出し、重複なしで「シートB」のA列とB列に転記する方法を解説します。

VBAコードの全体像

まずは、コード全体を見てみましょう。

Sub GetUniqueCombinations()
    Dim wsA As Worksheet, wsB As Worksheet
    Dim lastRow As Long, i As Long, writeRow As Long
    Dim dict As Object
    Dim key As String
    
    ' シートの設定
    Set wsA = ThisWorkbook.Worksheets("シートA")
    Set wsB = ThisWorkbook.Worksheets("シートB")
    
    ' ディクショナリオブジェクトの作成（重複チェック用）
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' シートAの最終行を取得
    lastRow = wsA.Cells(wsA.Rows.Count, "A").End(xlUp).Row
    
    ' シートBの書き込み開始行
    writeRow = 1
    
    ' シートAのデータを処理
    For i = 1 To lastRow
        key = wsA.Cells(i, 1).Value & "|" & wsA.Cells(i, 2).Value
        
        ' 重複していない場合のみ処理
        If Not dict.Exists(key) Then
            ' ディクショナリに追加
            dict.Add key, 1
            
            ' シートBに書き込み
            wsB.Cells(writeRow, 1).Value = wsA.Cells(i, 1).Value
            wsB.Cells(writeRow, 2).Value = wsA.Cells(i, 2).Value
            writeRow = writeRow + 1
        End If
    Next i
    
    MsgBox "処理が完了しました。"
End Sub

コードの詳細解説

1. 変数の宣言と初期設定

Dim wsA As Worksheet, wsB As Worksheet
Dim lastRow As Long, i As Long, writeRow As Long
Dim dict As Object
Dim key As String

' シートの設定
Set wsA = ThisWorkbook.Worksheets("シートA")
Set wsB = ThisWorkbook.Worksheets("シートB")

ここでは必要な変数を宣言し、作業対象のシートを設定しています。

2. ディクショナリオブジェクトの使用

' ディクショナリオブジェクトの作成（重複チェック用）
Set dict = CreateObject("Scripting.Dictionary")

ディクショナリオブジェクトを使用して、重複をチェックします。これにより、処理速度が向上します。

3. シートAのデータ処理ループ

' シートAの最終行を取得
lastRow = wsA.Cells(wsA.Rows.Count, "A").End(xlUp).Row

' シートAのデータを処理
For i = 1 To lastRow
    key = wsA.Cells(i, 1).Value & "|" & wsA.Cells(i, 2).Value
    
    ' 重複していない場合のみ処理
    If Not dict.Exists(key) Then
        ' ディクショナリに追加
        dict.Add key, 1
        
        ' シートBに書き込み
        wsB.Cells(writeRow, 1).Value = wsA.Cells(i, 1).Value
        wsB.Cells(writeRow, 2).Value = wsA.Cells(i, 2).Value
        writeRow = writeRow + 1
    End If
Next i

このループでは、シートAの各行を処理し、A列とB列の値を組み合わせてキーを作成します。そのキーがディクショナリに存在しない場合のみ、新しく追加してシートBに書き込みます。

コードの使用方法

1. ExcelのVBEを開きます（Alt + F11）。
2. 新しいモジュールを挿入します。
3. 上記のコードをコピーして貼り付けます。
4. マクロを実行します。

カスタマイズのヒント

• 列を変更したい場合は、wsA.Cells(i, 1) と wsA.Cells(i, 2) の数字を変更します。
• エラー処理を追加したい場合は、On Error GoTo ErrorHandler を使用し、エラーハンドリングのセクションを追加します。

まとめ

このVBAコードを使用することで、シート間のデータ転記作業を効率化し、重複を自動的に除去することができます。大量のデータを扱う際に特に役立つでしょう。

注意点

• 大量のデータを処理する場合は、実行に時間がかかる可能性があります。
• マクロを有効にするために、Excelのセキュリティ設定を確認してください。

以上で、ExcelのVBAを使ったシート間の重複なしデータ転記の自動化方法の解説を終わります。この方法を活用して、より効率的なExcel作業を行ってください。

---

• 補足

---

O列、P列、そして、先頭の0を残す検討

先頭のゼロを確実に保持してデータを転記する方法（最終修正版）

前回の説明にも不十分な点がありました。確実に先頭のゼロを保持するには、値だけでなくセルの書式も転記する必要があります。以下が正しい方法です。

修正箇所

1. セルの値と書式を両方転記します：

' シートBに書き込み
wsB.Cells(writeRow, 1).Value = wsA.Cells(i, 15).Value
wsB.Cells(writeRow, 2).Value = wsA.Cells(i, 16).Value
wsB.Cells(writeRow, 1).NumberFormat = wsA.Cells(i, 15).NumberFormat
wsB.Cells(writeRow, 2).NumberFormat = wsA.Cells(i, 16).NumberFormat

2. キーの作成時もTextプロパティを使用して、表示される値を基準にします：

key = wsA.Cells(i, 15).Text & "|" & wsA.Cells(i, 16).Text

修正後の完全なコード

Sub GetUniqueCombinations()
    Dim wsA As Worksheet, wsB As Worksheet
    Dim lastRow As Long, i As Long, writeRow As Long
    Dim dict As Object
    Dim key As String
    
    ' シートの設定
    Set wsA = ThisWorkbook.Worksheets("シートA")
    Set wsB = ThisWorkbook.Worksheets("シートB")
    
    ' ディクショナリオブジェクトの作成（重複チェック用）
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' シートAの最終行を取得
    lastRow = wsA.Cells(wsA.Rows.Count, "O").End(xlUp).Row
    
    ' シートBの書き込み開始行
    writeRow = 1
    
    ' シートAのデータを処理
    For i = 1 To lastRow
        key = wsA.Cells(i, 15).Text & "|" & wsA.Cells(i, 16).Text
        
        ' 重複していない場合のみ処理
        If Not dict.Exists(key) Then
            ' ディクショナリに追加
            dict.Add key, 1
            
            ' シートBに書き込み
            wsB.Cells(writeRow, 1).Value = wsA.Cells(i, 15).Value
            wsB.Cells(writeRow, 2).Value = wsA.Cells(i, 16).Value
            wsB.Cells(writeRow, 1).NumberFormat = wsA.Cells(i, 15).NumberFormat
            wsB.Cells(writeRow, 2).NumberFormat = wsA.Cells(i, 16).NumberFormat
            writeRow = writeRow + 1
        End If
    Next i
    
    MsgBox "処理が完了しました。"
End Sub

解説

この修正では以下の点を改善しています：

1. Valueプロパティを使用して元の値を転記します。これにより、数値や日付などのデータ型が保持されます。
2. NumberFormatプロパティを使用してセルの書式を転記します。これにより、先頭のゼロを含む書式設定が保持されます。
3. キーの作成にはTextプロパティを使用します。これにより、表示される値（先頭のゼロを含む）を基準に重複をチェックします。

この方法を使うことで、元のデータの値と形式を正確に保持したまま、ユニークな組み合わせを抽出し転記することができます。

注意点

• この方法では、元のセルの値と書式の両方が転記されます。そのため、シートAで先頭にゼロがある数値は、シートBでも同じように表示されます。
• 数式が入力されているセルの場合、数式自体ではなく計算結果が転記されます。数式を転記したい場合は、別途対応が必要です。

まとめ

ExcelのVBAでデータを転記する際、値だけでなく書式も考慮することが重要です。ValueプロパティとNumberFormatプロパティを組み合わせて使用することで、元のデータの見た目と内容を正確に保持したまま転記することができます。また、重複チェックにはTextプロパティを使用することで、表示される値を基準にユニークな組み合わせを抽出できます。

この方法を活用することで、先頭のゼロを含む数値や特殊な書式のデータも、正確に処理することができます。

---