
※当サイトで使用するデータは全て架空のサンプルデータです。
目次
別シートから商品の価格を転記する例
タイトル画像のように、商品名が一致する価格を転記する方法を解説していきます。
別シートから条件が一致した値を転記するには、下記のように転記元のシートと転記先シートの指定を行います。
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