【ExcelVBA】シート間で順不同のデータを整理して転記する方法

Excelで複数のシート間でデータを転記する作業を自動化する場合、Find関数を使うことでコードをシンプルに書けます。今回は、以下の条件を満たすVBAマクロを紹介します。

条件

1. Sheet1:
   • • A列に「名前」「会社名」「電話番号」「E-mail」などの項目名が入力されている（順番はバラバラ）。
     • B列にそれぞれの項目に対応するデータが入力されている。

   
2. Sheet2:
   • 1行目に「会社名」「名前」「E-mail」「電話番号」が固定位置で入力されている。
   • 2行目以降に何らかのデータが入っている。
   • 
3. 目的:
   • Sheet1のデータを正しい位置に並べ替え、Sheet2の最終行に追加する。

コード

以下がFind関数を使った簡潔なマクロコードです。

Sub MoveDataToSheet2_UsingFind()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lastRowSheet1 As Long, lastRowSheet2 As Long
    Dim headerCell As Range
    Dim foundCell As Range
    Dim dataRow(1 To 4) As Variant ' データ格納用の配列
    Dim i As Long
    
    ' シートの参照
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    
    ' Sheet1とSheet2の最終行を取得
    lastRowSheet1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
    lastRowSheet2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row
    
    ' Sheet2のヘッダーをループして対応するデータを取得
    For i = 1 To ws2.Cells(1, ws2.Columns.Count).End(xlToLeft).Column
        Set headerCell = ws2.Cells(1, i)
        Set foundCell = ws1.Range("A1:A" & lastRowSheet1).Find(What:=headerCell.Value, LookIn:=xlValues, LookAt:=xlWhole)
        
        If Not foundCell Is Nothing Then
            ' 該当する項目が見つかった場合、B列の値を配列に格納
            dataRow(i) = ws1.Cells(foundCell.Row, "B").Value
        Else
            ' 該当する項目がない場合は空欄を格納
            dataRow(i) = ""
        End If
    Next i
    
    ' Sheet2の最終行にデータを転記
    ws2.Cells(lastRowSheet2 + 1, 1).Resize(1, UBound(dataRow)).Value = dataRow
    
    MsgBox "データを転記しました！", vbInformation
End Sub
 

 

コードのポイント

• Find関数で項目を検索
  ws1.Range("A1:A" & lastRowSheet1).Findを使うことで、Sheet2のヘッダーと一致する項目をSheet1のA列から検索します。
• データの格納
  • 該当項目が見つかった場合、その行のB列のデータを配列dataRowに格納します。
  • 見つからなければ空欄を格納します。
• データの転記
  配列dataRowの内容を一括でSheet2の最終行に転記します。

実行結果

このマクロを実行すると、Sheet1のデータがSheet2の正しい位置に並べ替えられ、最終行に追加されます。

 

 - Excel, VBA