ＶＢＡ VLookupを使用時のエラーの解消方法を教えてください。

質問

ダイアログボックス(ユーザフォームで作成）で入力し、得意先台帳を作成しています。

入力したデータの項目に変更（例えば社名変更）があった場合、修正用のダイアログボックスを呼出し表示させ、修正をしたいので下記のように作成しました。

実行するとエラーになります。

エラーメッセージ
実行時エラー　1004
WorksheetFunctionクラスのVLookupプロパティを取得できません

教えていただきたき事。
１．エラーの解消方法
２．下記記述の誤謬

Private Sub koudo_afterUpdate()
Dim WS1 As Worksheet
Set WS1 = Worksheets("得意先登録")
Dim CODE As Long
If WorksheetFunction.CountIf(WS1.Range("D:D"), koudo.Value) = 0 Then
MsgBox "得意先コード未登録。"
koudo.SetFocus
Exit Sub
Else
If IsNumeric(koudo.Text) = True Then
CODE = Val(koudo.Text)
Else
CODE = koudo.Text
End If
tourokubi.Text = Application.WorksheetFunction.VLookup(CODE, WS1.Range("A:S"), 3, False)
　　　　・・・・・・・・・・
jouken.Text = WorksheetFunction.VLookup(CODE, WS1.Range("A:S"), 18, False)
End If
End Sub

回答No.16

Wendy02 · ベストアンサー

こんばんは。

もう一度、この内容に戻るまでは、少し時間をいただきたいです。

そういう私は、ちょうど三ヶ月前から、別の仕事が入って、こちらにはあまり集中的に書けません。

>来期の元帳（売掛金元帳・買掛金元帳）の６月シートのJ11に表示するところまで作成したかったからです。
その値の確保は可能ですが、来期の元帳を新規で作成するのかどうか、によって、その前後が変わってくるような気がします。

>一つ咲き　一つ散り行く　夏椿

沙羅の木で思い出しましたが、
「沙羅のみずえに花咲けば、かなしきひとの めぞみゆる」 （芥川龍之介）
芥川は別の意味で書いたけれども、この樹木の本来持つ意味で、この歌は一人歩きしています。
心のある人は、沙羅の花が咲いただけで、その時（この世から大事な人の命が消えたこと）を知る、という意味です。

補足

古い質問をわざわざ取り出し御連絡いただきありがとうございました。

●　>来期の元帳を新規で作成するのかどうか
2009年5月決算　→　"C:\Documents and Settings\AAA\My Documents￥販売管理\2009年5月決算\売掛金元帳\"

"C:\Documents and Settings\AAA\My Documents￥販売管理\2009年5月決算\買掛金元帳\"

"C:\Documents and Settings\AAA\My Documents￥販売管理\2009年5月決算\管理表\"

2010年5月決算　→　"C:\Documents and Settings\AAA\My Documents￥販売管理\2010年5月決算\売掛金元帳\"

"C:\Documents and Settings\AAA\My Documents￥販売管理\2010年5月決算\買掛金元帳\"

"C:\Documents and Settings\AAA\My Documents￥販売管理\2010年5月決算\管理表\"

１．上記のように新規で作成します。
２．2009年5月決算時の5月シートの残高を、2010年5月決算の6月シートのセルJ11に表示したい。
３．元帳より管理表(売掛金管理表・買掛金管理表）を使用した方が良いのだろうかと思案中です。

●　>もう一度、この内容に戻るまでは、少し時間をいただきたいです。
御多忙中申し訳御座いません。
期限のある勉強ではございませが宜しく御願いいたします。

●　>沙羅の木で思い出しましたが・・・・
龍之介の歌も、御解説の内容も知らなかったのですが、病床からみた散り行く花に、ふと感じたことでした・・・。

回答No.5

Wendy02

こんばんは。

今、CountIf を調べてみると、全角・半角の区別がないようですね。
途中からだったので、私は書かなかったのですが、Match 関数自体は、使い方の決まったパターンがあります。それを使わないとうまく行かないようです。97版と2000版とがあります。CountIfによる検索では、ダメのようです。
Match 関数自体で、判定を取らないとダメでした。

しかし、Match 関数は、全角・半角の区別があるので、今回は、取りやめです。

>Set WS1 = Worksheets("商品登録") '　（Ａ)・これは不要ですか

というか、実害はありないはずですが、私は、あまり、オブジェクトの出し入れは賛成しません。

Private WS1 As Worksheet
モジュール変数を置き、

UserForm 起動時に代入すれば、後は必要ありません。
Private Sub UserForm_Initialize()
　　Set WS1 = Worksheets("得意先登録")
End Sub

>If IsNumeric(koudo.Text) Then
>' CODE = CLng(koudo.Text) '　（Ｂ)・ここは　CLngを外してみました
>CODE = koudo.Text
>Else
>CODE = Val(koudo.Text)
>End If

半角数値でなければ、それは、Val 側に入り、値は「0」になります。
だから、
　Code = koudo.Text
としか書けません。

Private Sub koudo_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
　 Dim Code As Variant
　 i = 0
　　If KeyCode <> 13 Then Exit Sub

　　If IsError(myMatch(koudo.Value, WS1.Range("D:D"))) Then
　　　　MsgBox "得意先コード未登録。"
　　　　koudo.Text = "": tourokubi.Text = "": jouken.Text = ""
　　　　 KeyCode = 0
　　　　Exit Sub
　　Else
　　　　 Code = koudo.Text
　　　　With WS1
　　　　　　i = myMatch(Code, .Range("A:S").Columns(1))
　　　　　　If Not IsError(i) Then
　　　　　　tourokubi.Text = .Range("A:S").Columns(3).Cells(i)
　　　　　　jouken.Text = .Range("A:S").Columns(18).Cells(i)
　　　　End If
　　　　End With
　　End If
End Sub

Private Function myMatch(ByVal What As Variant, rng As Range) As Variant
'myMATCH(検査値,検査範囲)
Dim c As Range
　Set c = rng.Find(What, , xlValues, xlWhole, , , False, False)
　　　If Not c Is Nothing Then
　　　　myMatch = c.Row
　　　Else
　　　　myMatch = CVErr(xlErrValue)
　　　End If
End Function

p.s.早く書きたかったのですが、サイトにアクセスがしばらく出来ませんでした。

補足

Wendy02様
深夜にわたる、御指導ありがとうございました。

得意先・仕入先・商品コードの登録及び修正は考え通り出来ました。
それを利用した売掛金・買掛金元帳の入力も考え通り出来ました。
これも、Wendy02様の御指導の賜物と衷心より感謝申し上げます。

本来別質問にすべきかとは、思いますが今ひとつお教えください。

商品台帳（Workbook）の商品コードには、品名・得意先・売価・仕入先・仕入単価を持っています。

その為に、得意先台帳（Workbook）・仕入先台帳（Workbook）を参照しています。

２台帳を起動させていないとエラーになってしまいますので、下記のようにして立ち上げています。

立ち上げないで処理する方法が有るのでしょうか。

Private Sub Workbook_Open()
Workbooks.Open Filename:= _
"C:\Documents and Settings\AAA\My Documents\販売管理　台帳登録\得意先登録.xls"
Workbooks.Open Filename:= _
"C:\Documents and Settings\AAA\My Documents\販売管理　台帳登録\仕入先登録.xls"
ThisWorkbook.Activate

回答No.4

Wendy02

こんばんは。

本日、出かけなくてはならなかったのですが、一日中、頭の中で、何が原因か考えてしまいました。

oguno様レベルの人に教えるのは、なかなか難しいのです。まったくの初心者の人なら、コードをペッタリ貼って終わりなのですが、出来る人には、理解してもらわないと「採用（あまり好きな言葉ではないけれど）」されないので、いろんな想定をして説明が必要になってしまいますが、いろんな想像してしまいました。

それでも、何とか、うまくいってよかったです。
ただ、私の経験では、それは思った以上に、なかなか難しいです。

ひとつ行き詰まったときのアドバイスとしては、私のしている方法ですが、スモールサンプル(小さなシュミレーションのコード）を作ってみることですね。考え方自体があっているかどうかを調べてみることです。UserForm 上で、現行に使っているものを直接するのは、なかなかチェックがしにくいです。

そういう私が、数ヶ月前に、UserForm で、途中でさっぱり何をやっているか分からなくなってしまいました。あまり、細かいところにこだわりすぎ、途中でミスると、抜け出せなくなるようです。

ちなみに、今回の私の書いたMatch 関数は、VBAでは非常に多く使われます。検索スピードもなかなか速いです。

後、私は、内容的には、同じようなものを作ったことがあります。その時に、VBAの3年目ぐらいだったのですが、その時に、自分の未熟さを感じました。その後、UserForm というのは、もっと基礎的な使い方があるというのを、最近になって知ったのです。

お礼

Wendy02様
御免なさい。
お礼ではないのですが、下記添付するのを忘れましたので送ります
Private Sub koudo_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim CODE As Variant
i = 0
Set WS1 = Worksheets("商品登録") '　（Ａ)・これは不要ですか
If KeyCode <> 13 Then Exit Sub
If WorksheetFunction.CountIf(WS1.Range("D:D"), koudo.Value) = 0 Then
MsgBox "入力した商品コードは登録されておりません。 ", _
vbExclamation, "入力エラー"
koudo.Text = "": tourokubi.Text = "": bikou2.Text = ""
KeyCode = 0 '次に進ませないようにする
Exit Sub
Else
If IsNumeric(koudo.Text) Then
' CODE = CLng(koudo.Text) '　（Ｂ)・ここは　CLngを外してみました
CODE = koudo.Text
Else
CODE = Val(koudo.Text)
End If
With WS1
If WorksheetFunction.CountIf(.Range("A:S").Columns(4), CODE) > 0 Then
i = WorksheetFunction.Match(CODE, .Range("A:S").Columns(4), 0)

tourokubi.Text = .Range("A:S").Columns(3).Cells(i)
　・・・ （１０００文字に引掛りましたので一部省略 ）・・・

bikou2.Text = .Range("A:S").Columns(19).Cells(i)
End If
End With
End If
End Sub
宜しく御願いいたします。

補足

Wendy02様
お出かけでお疲れのところ、わざわざ深夜に御連絡いただきありがとうございました。

私の不注意で、お心煩わし申し訳御座いませんでした、御詫び申し上げます。

深夜２時ごろ拝見いたしましたが、仕入先台帳の修正を作成し終わり、商品台帳の修正に取りかっかておりましたので御連絡出来ませんでした。

商品台帳の修正で、四苦八苦しておりましたので、出来ませんでした言うよりも、あえてしなかったと、申し上げた方が正しいようです。

本やヘルプを見たりしましたが、今現在も完成出来ていません。
今一度、御指導お願い申し上げます。

★商品台帳修正ダイアログ
御指導いただきました得意先台帳と同じ処理を考えております。
得意先台帳と大きく違うところは商品コードだと思います。

★商品コード
半角英数字の場合（全角英数字の場合も有るかしれません）
文字列の場合等全てになると思います。

★動作確認
　　　登録コード　　　　 　 　　　　 結果　　　
　半角　 　　　全角　　　　　　　　半角　 　 全角　　
15と登録　　　登録なし　　　　　　　ＯＫ　　　　　エラー
登録なし　　　１５と登録　　　　　　エラー　　　　ＯＫ
15と登録　　　登録なし　　　　　　　ＯＫ　　　　　エラー
15と登録　　　１５と登録　　　　　　ＯＫ　　　　　ＯＫ

商品コードを　sss　と登録しますとエラーにはなりませんが、テキストボックスには表示されませんでした。

お疲れのところ恐縮ですが宜しく御願いいたします。

回答No.3

Wendy02

こんにちは。

oguno様のお名前は、私がいままで回答した約2300名の中でも、とても記憶がはっきりとしている一人です。

>そのダイアログボックスで変更項目だけ修正し、再度同じSheetの同じ行へ貼り付ける。

もしかしたら、意味が違っているかもしれませんが、以下のように考えてみました。

まず、AfterUpdate イベントはやめて、Keydown イベントにしてみました。そうすれば、次に進むかどうかは、その判定が出来ます。

また、Match 関数で、行数を取ることにしました。その行数を共有させて、CommandButton1 の修正用に使います。細かい部分は、まだ見ておりませんが、以下のように考えてみました。

'--------------------------------------
Private i As Long 　　'Match の行数
Private WS1 As Worksheet

Private Sub koudo_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
　 Dim Code As Variant
　 i = 0
　　If KeyCode <> 13 Then Exit Sub

　　If WorksheetFunction.CountIf(WS1.Range("D:D"), koudo.Value) = 0 Then
　　　　MsgBox "得意先コード未登録。"
　　　　koudo.Text = "": tourokubi.Text = "": jouken.Text = ""
　　　　 KeyCode = 0　'次に進ませないようにする
　　　　Exit Sub
　　Else
　　　　If IsNumeric(koudo.Text) Then
　　　　　　Code = CLng(koudo.Text)
　　　　Else
　　　　　　Code = Val(koudo.Text)
　　　　End If
　　　　With WS1
　　　　If WorksheetFunction.CountIf(.Range("A:S").Columns(1), Code) > 0 Then
　　　　　　i = WorksheetFunction.Match(Code, .Range("A:S").Columns(1), 0)
　　　　　　tourokubi.Text = .Range("A:S").Columns(3).Cells(i)
　　　　　　jouken.Text = .Range("A:S").Columns(18).Cells(i)
　　　　End If
　　　　End With
　　End If
End Sub

Private Sub CommandButton1_Click()
　With WS1
　If koudo.Text <> "" And tourokubi.Text <> "" And jouken.Text <> "" And i > 0 Then
　　　　.Range("A:S").Columns(3).Cells(i) = tourokubi.Text
　　　　.Range("A:S").Columns(18).Cells(i) = jouken.Text
　End If
　End With
End Sub

Private Sub UserForm_Initialize()
　　'シートを設定
　　Set WS1 = ThisWorkbook.Worksheets("得意先登録")
End Sub

Private Sub UserForm_Terminate()
　　'シートを解除
　　Set WS1 = Nothing
End Sub

お礼

Wendy02様申し訳御座いません。

厳しいお言葉を返される方もいらっしゃるのに、Wendy02様の優しさについつい、甘えていました、御容赦ください。

Wendy02様のご指導に誤りがあるはずが無い、また理解できないのは自分の努力が足りないからだと思い、朝から何度も、何度も、読み返してみました。

お笑いになるかもしれませんが、列の指定が間違っていました。

おかげさまで、考え通り動きました。

ありがとうございました。

「馬鹿やろう」と、一言お叱りのお言葉をいただきたいと思います。

それまで締め切らないでおきます。

まだ関連した事項に関し質問をさせて、いただくことになると思います

がogunoを見かけましたら宜しく御願いいたします。

但し、自分で考えられるだけ、考えてから質問させていただきます。

ありがとうございました。

本当にありがとうございました。

oguno

補足

Wendy02様
＞約2300名の中でも、とても記憶がはっきりとしている一人です。
悪印象でない事を念じるばかりです。
３時過ぎから６時まで試行錯誤しましたが理解できませんでした。
申し訳御座いません。

■結果は貼付けられませんでした。

長文になりますが、考えています処理を整理し直してみます。
もし、これ以上係わっておれないとお考えの時は、「指導できない」旨の御回答だけは是非お願い致します。

■新規登録（完成）
ダイアログボックス（以後　[新規DB]　と呼称）(ユーザフォームで作成）で入力し、得意先台帳を作成しています。

■修正処理１
修正処理用のダイアログボックス（以後　[修正DB]　と呼称)を作成
（例)　社名変更があった場合

１・[修正DB]　を呼び出す
２・[修正DB]　の　koudo.Text（得意先コード）に社名変更したいコードを入力する
３・全てのText　Boxに　　[新規DB]　　のデータを表示させる
４．社名を変更する（該当項目に新社名を入力する）
５・変更確認をする　→　 MsgBox "全て変更します"
６．修正終了ボタンクリックする
　　クリックで得意先台帳の旧該当行に　[修正DB]　の内容を貼り付けて　[修正DB]　を閉じる

■修正処理２
１・得意先コード未登録の場合　→　 MsgBox "得意先コード未登録。"
２・　[修正DB]　を呼出し何もしないで閉じる場合　→　修正終了ボタンクリックする

■得意先台帳の構成（Sheetは2枚です）
得意先登録.xls 　Sheet１の名称は　「得意先登録」
　　　　　　　　　　　Sheet２の名称は　「メモ」　です
・列項目
　[新規DB]　で下記のように作成しています。

With Range("得意先一覧")
'最下行に一行挿入する
insertRow = .Rows.Count
.Rows(insertRow).Insert Shift:=xlDown

'データをセルに入力する
.Cells(insertRow, 1) = tourokubi.Text
.Cells(insertRow, 2) = koudo.Text
.Cells(insertRow, 3) = syamei.Text
.Cells(insertRow, 4) = huri.Text
.Cells(insertRow, 5) = yuubin.Text
.Cells(insertRow, 6) = jusyo1.Text
.Cells(insertRow, 7) = jusyo2.Text
.Cells(insertRow, 8) = tel.Text
.Cells(insertRow, 9) = fax.Text
.Cells(insertRow, 10) = tanntou.Text
.Cells(insertRow, 11) = ranku.Text
.Cells(insertRow, 12) = zei.Text　←　コンボボックスを使用しています
.Cells(insertRow, 13) = hasuu.Text　←　コンボボックスを使用しています
.Cells(insertRow, 14) = simebi.Text　←　コンボボックスを使用しています
.Cells(insertRow, 15) = siharaibi.Text　←　コンボボックスを使用しています
.Cells(insertRow, 16) = jouken.Text
End With

　[新規DB]　と　[修正DB]　は全く同じです。
（新規登録時のダイアログボックスを兼用できますか？）

宜しく御願いいたします。

回答No.2

Wendy02

こんにちは。お久しぶりです。

基本的な書き方ですが、ふつうは、Vlookup は、エラートラップを入れるのですが、その分、コードがややこしくなります。私は、この場合は、Match 関数を使います。Match 関数は、非常に反応が速いです。

その代わりとして、CountIf は、基本的に、その範囲にエラーがなければ、エラーは発生しません。

CountIf で、

If WorksheetFunction.CountIf(WS1.Range("A:S").Columns(1),Code))>0 then
tourokubi.Text = WorksheetFunction.VLookup(Code, WS1.Range("A:S"), 3, False)

End If

というスタイルにすればよいのです。

私の読み間違えでなければ、元のコードからこんな風に考えました。
なお、本来なら、WS1.Range("A:S").Columns(1)　は、単に、WS1.Range("A:A")ですね。あえて、移動してもよいように考えました。

IsNumeric(koudo.Text)の意味が良く分かりませんが、数字なら、Clng でLong型にすればよいし、文字が入っているなら、Val 関数を使えばよいです。旧バージョンのような、メモリリークはないような気がします。

---------------------------------------------
Private Sub koudo_AfterUpdate()
　　Dim WS1 As Worksheet
　　Dim Code As Variant
　　Set WS1 = Worksheets("得意先登録")
　　If WorksheetFunction.CountIf(WS1.Range("D:D"), koudo.Value) = 0 Then
　　　　MsgBox "得意先コード未登録。"
　　　　' koudo.SetFocus
　　　　Exit Sub
　　Else
　　　　If IsNumeric(koudo.Text) Then
　　　　　　Code = CLng(koudo.Text)
　　　　Else
　　　　　　Code = Val(koudo.Text)
　　　　End If
　　　　If WorksheetFunction.CountIf(WS1.Range("A:S").Columns(1), Code) > 0 Then
　　　　　　tourokubi.Text = WorksheetFunction.VLookup(Code, WS1.Range("A:S"), 3, _
　　　　　　False)
　　　　　　jouken.Text = WorksheetFunction.VLookup(Code, WS1.Range("A:S"), 18, False)
　　　　End If
　　End If
End Sub

-----------------------------------
なお、予約語（予めシステムにある名称）を使うのは、あまり好ましい書き方ではありませんが、VBA自身には、予約語のエラーは、ほとんど存在しませんので、何でもありです。

補足

Wendy02様
＞こんにちは。お久しぶりです。
半年振りございます。

多勢の質問者に懇切丁寧に御回答なさっているWendy02様が覚えていていただけた事は感激です。

もっともいつも、まる投げに近い形で質問している奴だなという事で覚えていただいていたのでしょう（笑）

今回もご丁寧なご回答ありがとうございます。
お蔭様でエラーは出なくなりました、ありがとうございました。

現状、あと２点思い通りにならないことが有ります。
勝手ですが、お教え下さい。

御願 １
★現在のSheetの内容を、ダイアログボックスのTextboxへ全て表示させて、そのダイアログボックスで変更項目だけ修正し、再度同じSheetの同じ行へ貼り付ける。
このように考えていますが、表示されません。
尚、Sheetへの張り付けはコマンドボタンで作成済みです。

御願 ２
＞MsgBox "得意先コード未登録。"
　　　　' koudo.SetFocus
　　　　Exit Sub

koudo.Textへ戻したいのですがtourokubi.Textに戻ってしまいます。
（コメントブロックは外しました。）

宜しく御願いいたします。

回答No.1

noname#79209

関係ないかもしれませんが、
変数名CODEは2バイト化の関数名ではなかったでしょうか。

変数名をつける際には、頭に変数の型を表すモノをつけると、
変数の型を直ぐ判別出来ますし、予約後や関数名とのバッティングも回避できます。
例：CODE→lngCODE

> WorksheetFunctionクラスのVLookupプロパティを取得できません
のエラーメッセージも、多分CODEを関数として認識しているためのエラーだと思われます。