エクセルVBAを使用して、VLOOKUPと全く同じことがしたいです。

エクセルVBAを使用して、VLOOKUPと全く同じことがしたいです。
A列にある項目の最終行まで、B列にVBAでVLOOKUPみたいなことをさせたいです。

sheet1
A列　　　B列
りんご　　10円
みかん　　30円
ばなな　　40円

sheet2
A列
みかん　　10円
りんご　　30円
ばなな　　40円

エクセルバージョンは2013です。

質問者からの補足コメント

• ワークシート関数がものすごく早いですね！
  この質問から若干ずれてしまうのですが、
  
  =IF(SUMPRODUCT((Sheet1!A$2:A$5000=A2)*(Sheet1!F$2:F$5000<>""))=0,"ひとつもない","")
  　　⇒Sheet1のA列のみかんがSheet2のA列のみかん　でかつ　Sheet1のF列が空白でないものを抽出
  したいのです。
  
  このIF関数とｻﾑﾌﾟﾛﾀﾞｸﾄ関数の組み合わせをこのVBAで使用したいのですが、やりかたありますか。

  No.1の回答に寄せられた補足コメントです。 補足日時：2015/04/24 06:09

• 迅速な対応ありがとうございます。
  
  下記のサンプル３で
  With Worksheets("Sheet2").Range("B2:B5000")
  ⇒ここのデータのある最終行までとする場合どうすればよいのでしょうか。
  
  Sub Sample3()
  With Worksheets("Sheet2").Range("B2:B5000")
  .Formula = "=IF(COUNTIFS(Sheet1!A$2:A$5000,A2,Sheet1!F$2:F$5000,""<>""),"""",""ひとつもない"")"
  .Value = .Value
  End With
  End Sub

  No.3の回答に寄せられた補足コメントです。 補足日時：2015/04/24 14:10

No.4 回答者： tom04 回答日時： 2015/04/24 16:55

No.1・3です。

＞With Worksheets("Sheet2").Range("B2:B5000")
＞⇒ここのデータのある最終行までとする場合どうすればよいのでしょうか。

今回の数式に関しては参照先の範囲指定が必要になります。
Sheet1の最終行が判らないので、列全体を対象としても良いのですが、
それでは計算速度がかなり落ちてしまうため、とりあえずSheet1の20000行までの範囲としてみました。
（ワークシート関数の数式をそのまま使用する場合、セル番地が必要になりますので・・・）
※　Sheet1のデータは20000行まであってもなくても問題ありません。

Sub Sample4()
Dim lastRow As Long
With Worksheets("Sheet2")
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row '//←Sheet2のA列最終行
With Range(.Cells(2, "B"), .Cells(lastRow, "B"))
.Formula = "=IF(COUNTIFS(Sheet1!A$2:A$20000,A2,Sheet1!F$2:F$20000,""<>""),"""",""ひとつもない"")"
.Value = .Value
End With
End With
End Sub

こんな感じではどうでしょうか？m(_ _)m

No.3 回答者： tom04 回答日時： 2015/04/24 07:08

No.1です。

補足の関数をそのままコードにするだけですが
文字列には通常の関数と異なり、ダブルクォーテーションを追加してやる必要があります。

Sub Samle2()
With Worksheets("Sheet2").Range("B2:B5000")
.Formula = "=IF(SUMPRODUCT((Sheet1!A$2:A$5000=A2)*(Sheet1!F$2:F$5000<>""""))=0,""ひとつもない"","""")"
.Value = .Value
End With
End Sub

※　Excel2013をお使いだというコトですので、計算速度が遅くなる
SUMPRODUCT関数（配列数式）ではなくCOUNTIFS関数で対応できると思います。

Sub Sample3()
With Worksheets("Sheet2").Range("B2:B5000")
.Formula = "=IF(COUNTIFS(Sheet1!A$2:A$5000,A2,Sheet1!F$2:F$5000,""<>""),"""",""ひとつもない"")"
.Value = .Value
End With
End Sub

といった感じの方が速いと思います。

※　数式がそのまま残っても良いのであれば

Sub Sample4()
Worksheets("Sheet2").Range("B2:B5000").Formula = _
"=IF(COUNTIFS(Sheet1!A$2:A$5000,A2,Sheet1!F$2:F$5000,""<>""),"""",""ひとつもない"")"
End Sub

ぐらいでOKだと思います。m(_ _)m

No.2 回答者： hallo-2007 回答日時： 2015/04/23 20:08

そのまま、VBAのWorksheetfunctionを使ってはどうでしょうか

Sheet2の名前のタブを右クリック
コードの表示をクリック
VBエディターが起動したら
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Column = 1 Then
Target.Offset(0, 1).Value = WorksheetFunction.VLookup(Target.Value, Sheets("Sheet1").Columns("A:B"), 2, False)
End If
End Sub
を張り付けて閉じる。
A列に、何か入れるとB列に答えが出ると思います。

No.1 回答者： tom04 回答日時： 2015/04/21 14:31

こんにちは！

質問の上側がSheet1で下側がSheet2とし、
両Sheetとも1行目は項目行で、データは2行目以降にあるとします。

いかにもVBAらしい感じとしては

Sub Sample1()
Dim i As Long, c As Range, wS As Worksheet
Set wS = Worksheets("Sheet1")
With Worksheets("Sheet2")
For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
Set c = wS.Range("A:A").Find(what:=.Cells(i, "A"), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
.Cells(i, "B") = c.Offset(, 1)
End If
Next i
End With
End Sub

こんな感じでしょうかね。

VBAでもワークシート関数がそのまま利用できますので、↓の方が簡単かもしれません。

Sub Sample2()
Dim lastRow As Long
With Worksheets("Sheet2")
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
With Range(.Cells(2, "B"), .Cells(lastRow, "B"))
.Formula = "=IF(COUNTIF(Sheet1!A:A,A2),VLOOKUP(A2,Sheet1!A:B,2,FALSE),"""")"
.Value = .Value
End With
End With
End Sub

こんな感じではどうでしょうか？m(_ _)m