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を使わずに
行いたいです。どういった式を組み立てればよいでしょうか？
No.3
3454
969
50pt
コメントにもあるように既にある関数を作るのはあまり意味はありませんが、
学習目的や他の関数の応用としてなら作る意味はあるかと思います。
VLOOKUPの４つ目の引数の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
No.1
2915301
27pt
VBA は VisualBasic for Application の略なのですが、その名の示すとおり、
何らかのアプリケーション用に特化したVBAであるという事です。
VLookupモドキのことをしたいということで、ExcelVBAだと仮定しますと、
Rangeオブジェクトに対して Find メソッド を使って対象を見つけ出すのが楽です。
※ Find関数やとはFindメソッドは別物です。今回使うのはメソッドのほうです。
※ Findステートメントと書いているページもありますが間違いです。
コードを書こうかとも思ったけど、「Excel Findメソッド」で探せば、
サンプルは沢山あるので、いくつかリンクだけで失礼。
No.2
11119
27pt
一応VBAで作成して見ましたが…
※Vlookup関数でも問題はないと思います。
また検索時間も掛かるかも知れませんね。
ユーザ関数を次のようにしました。
=検索(A1,[B]Sheet1!$A:$B,2)
以下のVBAでできると思います。
186
163
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
||<
御丁寧にコードを書いて頂きありがとうございます。やりたいことはコードを勉強したいと思ったからです。とても参考になりました！！
No.3
3454969
ここでベストアンサー
50pt
コメントにもあるように既にある関数を作るのはあまり意味はありませんが、
学習目的や他の関数の応用としてなら作る意味はあるかと思います。
VLOOKUPの４つ目の引数の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
御丁寧にコードを書いて頂きありがとうございます。やりたいことはコードを勉強したいと思ったからです。とても参考になりました！！
きゃづみぃ
2010/01/31 22:00:41
Mook
kn1967
2
2
1
御丁寧にコードを書いて頂きありがとうございます。やりたいことはコードを勉強したいと思ったからです。とても参考になりました！！