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を使わずに
行いたいです。どういった式を組み立てればよいでしょうか?

回答の条件
  • 1人2回まで
  • 登録:2010/01/31 21:06:35
  • 終了:2010/02/04 22:20:28

ベストアンサー

id:SALINGER No.3

SALINGER回答回数3454ベストアンサー獲得回数9692010/01/31 23:39:10

ポイント50pt

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

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


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
id:akaired

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

2010/02/04 22:19:49

その他の回答(2件)

id:kn1967 No.1

kn1967回答回数2915ベストアンサー獲得回数3012010/01/31 22:12:47

ポイント27pt

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

id:jccrh1 No.2

jccrh1回答回数111ベストアンサー獲得回数192010/01/31 23:34:26

ポイント27pt

一応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
||< 
id:akaired

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

2010/02/04 22:19:58
id:SALINGER No.3

SALINGER回答回数3454ベストアンサー獲得回数9692010/01/31 23:39:10ここでベストアンサー

ポイント50pt

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

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


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
id:akaired

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

2010/02/04 22:19:49
  • id:taknt
    findでも使ったら?
  • id:Mook
    標準関数でできることを、なぜVBAで実装したいのでしょうか。
    速度も遅くなりますし、機能面の保障も自己責任になります。

    また、関数にない拡張性がなければ、やる意味もないと思いますが、
    今回の説明からはVLOOKUPにない機能の見当がつかないのですが、
    目的は何になるでしょうか?
  • id:kn1967
    >findでも使ったら?

    コメントのほうが早かった・・・。
    私の回答はまさに、そのFINDメソッドを使った方法の紹介だけなので、
    別に開けなくてもいいですよ。> id:akaired さん

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません