エクセル 別シートから値を検索して挿入 VBA

質問

いつもお世話になっております。
VBAにて、Sheet1 の【原価】に【商品】をキーにしてSheet2の【原価】を検索して挿入するコードを作成しました。

元々Shee1の【原価】にはすでに数値が入っていますが、下記のコードを実行すると上書きする処理のため、検索にヒットしない商品の【原価】はエラー【#N/A】となります。

※画像参照願います。

目的はヒットする商品名の【原価】のみが更新される、
ヒットしない場合エラー【#N/A】を出さないようにする。

改良をご教示頂ければ助かります。

Sub データ検索()
Application.ScreenUpdating = False
Dim I As Long
　 I = 2
Do While Range("A" & I).Value <> ""
　ThisWorkbook.Worksheets("Sheet1").Range("C" & I).Value = _
　 Application.VLookup(ThisWorkbook.Worksheets("Sheet1").Range("B" & I).Value, Worksheets　("Sheet2").Range("A2:B65535"), 2, 0)
　I = I + 1
Loop
Application.ScreenUpdating = True
End Sub

回答No.5

dogs_cats · ベストアンサー

sheet1に既に単価が入力されてるなら空白を入力しないようにするだけでしょう。その修正も出来ませんか？

Sub データ検索()

Dim I As Long
Dim ws As Worksheet

Application.ScreenUpdating = False

Set ws = Sheets("sheet2")

With Sheets("sheet1")

I = 2

Do While .Range("A" & I).Value <> ""

If Application.CountIf(ws.Range("A:A"), .Range("B" & I)) = 1 Then
.Range("C" & I).Value = _
Application.VLookup(.Range("B" & I).Value, ws.Range("A:B"), 2, 0)
End If
I = I + 1
Loop

End With

Application.ScreenUpdating = True

End Sub

お礼

dogs_cats さん、ありがとうございます。コード内容が一番シンプルで解読しやすいため、ベストアンサーとさせて頂きました。おっしゃる通り勉強致します。ほかの方もご回答ありがとうございました。

回答No.4

kagakusuki

こういう方法もあります。

Sub Macro1()

Const mySheetName1 = "Sheet1"
Const FirstRow1 = 2
Const CommodityColumn1 = 2
Const CostColumn1 = 3
Const mySheetName2 = "Sheet2"
Const FirstRow2 = 3
Const CommodityColumn2 = 1
Const CostColumn2 = 2
Dim mySheetName(1) As String, mySheet(1) As Worksheet _
, LastRow As Long, i As Long, c As Range

mySheetName(0) = "Sheet1"
mySheetName(1) = "Sheet2"
For i = 0 To 1
Set mySheet(i) = Sheets(mySheetName(i))
Next i

With mySheet(0)
LastRow = .Cells(Rows.Count, CostColumn1).End(xlUp).Row
If LastRow < FirstRow1 Then Exit Sub
Application.ScreenUpdating = False
Application.Calculation = xlManual
With Range(.Cells(FirstRow1, CostColumn1), .Cells(LastRow, CostColumn1))
For Each c In .Offset(0)
c.FormulaR1C1 = "=IF(RC" & CommodityColumn1 & "="""","""",IF(COUNTIF(" _
& mySheetName(1) & "!C" & CommodityColumn2 & ",RC" & CommodityColumn1 _
& "),VLOOKUP(RC" & CommodityColumn1 & "," & mySheetName(1) & "!C" _
& CommodityColumn2 & ":C" & CostColumn2 _
& "," & CostColumn2 - CommodityColumn2 + 1 & ",FALSE)," & c.Value & "))"
Next c
.Parent.Calculate
.Value = .Value
End With
End With

With Application
.Calculation = xlAutomatic
.ScreenUpdating = True
End With

End Sub

補足

kagakusuki さん、ご回答ありがとうございます。正直今のレベルでは内容が理解できません。ゆっくりですが勉強して解読したいと思います。
ありがとうございました。

回答No.3

keithin

ん？

＞関数式は残したくありません。
＞数値として残す場合はどのような処置となりますでしょうか？

回答したマクロの最後の方の３カ所の「’」を消します。

＃コピーして動かしてみたー　できたー　ダメだったー　でオワリじゃなくて，回答のマクロがナニをやってるのかご自分なりにちょっと考えてみると良いと思います。

お礼

keithin さん、早速にありがとうございます。おっしゃる通り勉強不足です。勉強致します。ありがとうございました！

回答No.2

keithin

アイデア次第でやりようはいくらでもあります。

作成例：セルをイチイチ巡回するのもやめ。該当データ行だけ限定で一気にVLOOKUPする

sub macro1()
　worksheets("Sheet1").range("B:B").advancedfilter _
　　action:=xlfilterinplace, _
　　criteriarange:=worksheets("Sheet2").range("A1:A" & worksheets("Sheet2").range("A65536").end(xlup).row), _
　　unique:=false

　worksheets("Sheet1").range("C2:C" & worksheets("Sheet1").range("B65536").end(xlup).row).specialcells(xlcelltypevisible).formular1c1 _
　= "=VLOOKUP(RC[-1],Sheet2!C1:C2,2,FALSE)"
　worksheets("Sheet1").showalldata

’with worksheets("Sheet1").range("C2:C" & worksheets("Sheet1").range("B65536").end(xlup).row)
’　.value = .value
’end with
end sub

補足

keithin さん、早速にご回答ありがとうございます。

おおむね、ご回答頂きました処置で目的は達成しておりますが
関数式は残したくありません。

数値として残す場合はどのような処置となりますでしょうか？
お手数ですがよろしくお願い致します。

回答No.1

dogs_cats

countif関数で商品名の有無を検索すれば良いのでは。
本コードでは他のBOOKをオープンさせていないのでthisworkbookは不要と判断しました。

商品名が存在しない場合は空白を単価に入力する事にしています。

Sub データ検索()

Dim I As Long
Dim ws As Worksheet

Application.ScreenUpdating = False

Set ws = Sheets("sheet2")

With Sheets("sheet1")

I = 2

Do While .Range("A" & I).Value <> ""

If Application.CountIf(ws.Range("A:A"), .Range("B" & I)) = 1 Then
.Range("C" & I).Value = _
Application.VLookup(.Range("B" & I).Value, ws.Range("A:B"), 2, 0)
Else
.Range("C" & I).Value = ""
End If
I = I + 1
Loop

End With

Application.ScreenUpdating = True

End Sub

sheet2をwsというオブジェクト変数に格納して、コードを短くしています。
http://officetanaka.net/excel/vba/variable/04.htm

withステートメントでsheet1を指定しています。
sheet1に関するrangeの前にピリオドを付ける必要があります。

withステートメントの説明
http://officetanaka.net/excel/vba/beginner/16.htm

補足

dogs_cats さん、早速にご回答・参考ありがとうございます。

↓↓
商品名が存在しない場合は空白を単価に入力する事にしています。

ご説明不足で申し訳ございません。

元々Sheet1の商品にすべて原価が入っており、
VBAを実行すると該当の商品名だけが更新され、空白およびエラー【#N/A】にならないように処理し、
かつ、該当しない商品名の原価はそのままの数値を残したいと考えております。お手数ですがその場合はどのような処理となりますでしょうか？