人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

Vlookupと同じような事をVBAでやりたいです。条件として、Application.WorksheetFunction.VLookupを使わないことです。

A.xlsとB.xlsがあります。A.xlsのC列には検索キーとなる値が入っています。
例えば、C1=01,C2=02などです。
B.xlsのA列には検索対象の文字列が入っています。例えば、A1=01,A2=02...
B列には値が入っています。B1=XX,B2,YY....

Vlookupを使えば、
VLOOKUP(A1,[B.xls]Sheet1!A:B,2,0)といったような関数になるでしょうか。
つまり、A.xlsのA列の検索キーでB.xlsのA列を検索する。B.xlsのA列に対象のキーがあれば、
B列の値を返すといったことをApplication.WorksheetFunction.VLookupを使わずに
行いたいです。どういった式を組み立てればよいでしょうか?

●質問者: akaired
●カテゴリ:コンピュータ
✍キーワード:A1 application b2 VBA xls
○ 状態 :終了
└ 回答数 : 3/3件

▽最新の回答へ

1 ● kn1967
●27ポイント

VBA は VisualBasic for Application の略なのですが、その名の示すとおり、

何らかのアプリケーション用に特化したVBAであるという事です。

VLookupモドキのことをしたいということで、ExcelVBAだと仮定しますと、

Rangeオブジェクトに対して Find メソッド を使って対象を見つけ出すのが楽です。

※ Find関数やとはFindメソッドは別物です。今回使うのはメソッドのほうです。

※ Findステートメントと書いているページもありますが間違いです。


コードを書こうかとも思ったけど、「Excel Findメソッド」で探せば、

サンプルは沢山あるので、いくつかリンクだけで失礼。

http://www.moug.net/tech/exvba/0050116.htm

http://home.att.ne.jp/zeta/gen/excel/c04p42.htm


2 ● jccrh1
●27ポイント

一応VBAで作成して見ましたが…

※Vlookup関数でも問題はないと思います。

また検索時間も掛かるかも知れませんね。

ユーザ関数を次のようにしました。

=検索(A1,[B]Sheet1!$A:$B,2)

以下のVBAでできると思います。

Function 検索(検索値 As Range, 検索範囲 As Range, 結果列 As Integer) As Variant
 Dim 行 As Long
 Dim 実検索範囲 As Range
 検索 = "該当なし"
 ' セルに値が入っている行まで検索(最大行の検索は無駄なので)
 Set 実検索範囲 = Application.Intersect(検索範囲, 検索範囲.Worksheet.UsedRange)
 For 行 = 1 To 実検索範囲.Rows.Count
 If 実検索範囲(行, 1) = 検索値 Then
 検索 = 実検索範囲(行, 結果列)
 Exit Function
 End If
 Next 行
End Function
||< 
◎質問者からの返答

御丁寧にコードを書いて頂きありがとうございます。やりたいことはコードを勉強したいと思ったからです。とても参考になりました!!


3 ● SALINGER
●50ポイント ベストアンサー

コメントにもあるように既にある関数を作るのはあまり意味はありませんが、

学習目的や他の関数の応用としてなら作る意味はあるかと思います。


VLOOKUPの4つ目の引数のTRUEの場合を実装しておきました。

また、出来る限り同じエラーを返すようにしておきました。

Function MYLOOKUP(r1 As Variant, r2 As Variant, i As Variant, Optional f As Boolean = True) As Variant
 Dim r As Range
 Dim j As Long
 Dim num As Double
 Dim k As Long
 
 If TypeName(r1) = "Range" And TypeName(r2) = "Range" And TypeName(i) = "Double" Then
 If r2.Columns.Count >= i Then
 If f Then
 If IsNumeric(r1.Value) Then
 num = -1.79769313486232E+38
 For j = 0 To r2.Rows.Count - 1
 If IsNumeric(Cells(r2.Row + j, r2.Column).Value) Then
 If Cells(r2.Row + j, r2.Column).Value <= r1.Value Then
 If num < Cells(r2.Row + j, r2.Column).Value Then
 num = Cells(r2.Row + j, r2.Column).Value
 k = r2.Row + j
 End If
 End If
 End If
 Next j
 If num = -1.79769313486232E+38 Then
 MYLOOKUP = CVErr(xlErrNA)
 Else
 MYLOOKUP = Cells(k, r2.Column + i - 1).Value
 End If
 Else
 MYLOOKUP = CVErr(xlErrNA)
 End If
 Else
 Set r = Range(r2, Cells(r2.Row + r2.Rows.Count - 1, r2.Column)).Find(r1.Value, LookAt:=xlWhole)
 If Not r Is Nothing Then
 MYLOOKUP = r.Offset(0, i - 1).Value
 Else
 MYLOOKUP = CVErr(xlErrNA)
 End If
 End If
 Else
 MYLOOKUP = CVErr(xlErrRef)
 End If
 Else
 MYLOOKUP = CVErr(xlErrNA)
 End If
End Function
◎質問者からの返答

御丁寧にコードを書いて頂きありがとうございます。やりたいことはコードを勉強したいと思ったからです。とても参考になりました!!

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ