別シート又は別ブックから条件が一致したら転記する方法

2024年10月17日

※当サイトで使用するデータは全て架空のサンプルデータです。

別シートから商品の価格を転記する例

タイトル画像のように、商品名が一致する価格を転記する方法を解説していきます。

別シートから条件が一致した値を転記するには、下記のように転記元のシートと転記先シートの指定を行います。


Dim WsTenkiMoto As Worksheet
Dim WsTenkiSaki As Worksheet

Set WsTenkiMoto = ThisWorkbook.Worksheets("転記元データ")  '転記元のシート
Set WsTenkiSaki = ThisWorkbook.Worksheets("転記先")       '転記先のシート

条件と一致する値を転記していくには、転記先の最初の行から最後の行まで繰り返し処理を行い、商品名を転記元シートからFindを使用して検索しながら転記をしていきます。

下記の例は、指定した列から値を検索する例です。

Columns(検索する列).Find(検索する値)

行を指定して検索する場合は下記のようになります。

Rows(検索する列).Find(検索する値)

セルの範囲を指定して検索をする場合は下記のようになります。

Range(検索するセル範囲).Find(検索する値)

下記のようにLookAt:=xlWholeと指定すると完全一致で検索するように設定できます。
LookAt:=xlPartと指定すると部分一致で検索することになります。

Range(検索するセル範囲).Find(検索する値, LookAt:=xlWhole) ・・・完全一致で検索
Range(検索するセル範囲).Find(検索する値, LookAt:=xlPart) 　・・・部分一致で検索

下記のサンプルコードは、転記先の2行目から最終行までループを行いFindにて転記元の商品名から検索をし、同じ商品名が見つかった場合は価格を転記しています。
もし見つからなかった場合は、価格のセルを黄色で塗りつぶしています。


Sub 価格転記_別シート()

    '変数を用意します
    Dim WsTenkiMoto As Worksheet
    Dim WsTenkiSaki As Worksheet
    Dim SearchValue As String
    Dim FindRng As Range
    Dim i As Long, LastRow As Long

    '転記元と転記先のシートを指定します
    Set WsTenkiMoto = ThisWorkbook.Worksheets("転記元データ")
    Set WsTenkiSaki = ThisWorkbook.Worksheets("転記先")

    '転記先の最終行を取得します
    LastRow = WsTenkiSaki.Cells(Rows.Count, "A").End(xlUp).Row

    '転記先シートの2行目から最終行までをループします
    For i = 2 To LastRow
        
        '検索する文字を指定します
        SearchValue = WsTenkiSaki.Cells(i, "B").Value
        
        '転記元データのシートのB列から同じ商品名を検索します(LookAt:=xlWhole = 完全一致)
        Set FindRng = WsTenkiMoto.Columns("B").Find(SearchValue, LookAt:=xlWhole)
        
        '転記元データのB列から条件に一致する値が見つかった場合、価格を転記します（見つからなかった場合は、価格のセルを黄色で塗りつぶします）
        If Not FindRng Is Nothing Then
            WsTenkiSaki.Cells(i, "D").Value = WsTenkiMoto.Cells(FindRng.Row, "D").Value  '見つかった場合
        Else
            WsTenkiSaki.Cells(i, "D").Interior.Color = vbYellow  '見つからなかった場合
        End If
        
    Next i

    'リソースを開放します
    Set FindRng = Nothing
    Set WsTenkiMoto = Nothing
    Set WsTenkiSaki = Nothing

End Sub

上記のサンプルコードでは「If Not FindRng Is Nothing Then」の箇所で同じ商品名が見つかったかを判断しています。

もし、検索した値が見つからなかった場合、FindRngには「Nothing」が返されます。

FindRngにNothingが返されたかを「Is Nothing」の箇所で判断をしています。

別ブックから商品の価格を転記する例

別ブックから条件が一致した値を転記するには、下記のように転記元のブックをOpenメソッドで開き、開いたブックのデータを取得するシートを指定します。


Dim WbTenkiMoto As Workbook
Dim WsTenkiMoto As Worksheet

'下記のフルパスは転記元のデータがある場所を指定してください
Set WbTenkiMoto = Workbooks.Open("C:\Users\○○\Desktop\転記元.xlsm")
Set WsTenkiMoto = WbTenkiMoto.Worksheets("転記元データ")

以降は別シートからデータを転記する時と同様に転記元データから一致するデータを検索しながら転記をしていきます。

下記が別ブックから転記するサンプルコードです。


Sub 価格転記_別ブック()

    '変数を用意します
    Dim WbTenkiMoto As Workbook
    Dim WsTenkiMoto As Worksheet
    Dim WsTenkiSaki As Worksheet
    Dim SearchValue As String
    Dim FindRng As Range
    Dim i As Long, LastRow As Long

    '転記元のブックを開きます(下記のフルパスは転記元のデータがある場所を指定してください)
    Set WbTenkiMoto = Workbooks.Open("C:\Users\○○\Desktop\転記元.xlsm")

    '転記元と転記先のシートを指定します
    Set WsTenkiMoto = WbTenkiMoto.Worksheets("転記元データ")
    Set WsTenkiSaki = ThisWorkbook.Worksheets("転記先")

    '転記先の最終行を取得します
    LastRow = WsTenkiSaki.Cells(Rows.Count, "A").End(xlUp).Row

    '転記先シートの2行目から最終行までをループします
    For i = 2 To LastRow
        
        '検索する文字を指定します
        SearchValue = WsTenkiSaki.Cells(i, "B").Value
        
        '転記元データのシートのB列から同じ商品名を検索します(LookAt:=xlWhole = 完全一致)
        Set FindRng = WsTenkiMoto.Columns("B").Find(SearchValue, LookAt:=xlPart)
        
        '転記元データのB列から条件に一致する値が見つかった場合、価格を転記します（見つからなかった場合は、価格のセルを黄色で塗りつぶします）
        If Not FindRng Is Nothing Then
            WsTenkiSaki.Cells(i, "D").Value = WsTenkiMoto.Cells(FindRng.Row, "D").Value  '見つかった場合
        Else
            WsTenkiSaki.Cells(i, "D").Interior.Color = vbYellow  '見つからなかった場合
        End If
        
    Next i

    'リソースを開放します
    Set FindRng = Nothing
    Set WsTenkiMoto = Nothing
    Set WsTenkiSaki = Nothing
    Set WbTenkiMoto = Nothing

End Sub

	条件に一致する行を取得する方法
	空白を判定し、空白行を削除する方法
	シートをコピーして新規ブックを作成

別シート又は別ブックから条件が一致したら転記する方法

別シートから商品の価格を転記する例

別ブックから商品の価格を転記する例

関連記事