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

Question

ダイアログボックス(ユーザフォームで作成）で入力し、得意先台帳を作成しています。

入力したデータの項目に変更（例えば社名変更）があった場合、修正用のダイアログボックスを呼出し表示させ、修正をしたいので下記のように作成しました。

実行するとエラーになります。

エラーメッセージ
実行時エラー　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

Wendy02 · Accepted Answer

こんばんは。

もう一度、この内容に戻るまでは、少し時間をいただきたいです。

そういう私は、ちょうど三ヶ月前から、別の仕事が入って、こちらにはあまり集中的に書けません。

>来期の元帳（売掛金元帳・買掛金元帳）の６月シートのJ11に表示するところまで作成したかったからです。 
その値の確保は可能ですが、来期の元帳を新規で作成するのかどうか、によって、その前後が変わってくるような気がします。

>一つ咲き　一つ散り行く　夏椿

沙羅の木で思い出しましたが、
「沙羅のみずえに花咲けば、かなしきひとの めぞみゆる」 （芥川龍之介）
芥川は別の意味で書いたけれども、この樹木の本来持つ意味で、この歌は一人歩きしています。
心のある人は、沙羅の花が咲いただけで、その時（この世から大事な人の命が消えたこと）を知る、という意味です。

Wendy02 · Answer

補足2:

前回の補足を書いた後に、もう一度、全面的に、考え方を修正してみました。必要のないロスを減らしました。以下は、新たに「標準モジュール」を挿入し、別の場所に入れてください。
もしくは、前のものは使わなくてもよいと思います。

------------------------------------------------

Sub GetDatainFolder2()
　　Dim i As Long
　　Dim Fname As String
　　Dim n As Integer
　　'Const MYFOLDER As String = "C:\Documents and Settings\AAA\My Documents\販売管理\売掛金元帳\"
　 
　　Application.ScreenUpdating = False
　　
　　Fname = Dir(MYFOLDER & "*.xls")
　　
　　On Error Resume Next
　　Do Until Len(Fname) = 0
　　　　Fname = MYFOLDER & Fname
　　　　For n = 1 To 12 '(n + 4) Mod 12 は、６月から
　　　　　　With Worksheets(n) '書き込みシートは、左から順に書き込み
　　　　　　　　FormPickUP .Range("C6").Offset(i), Fname, CStr(((n + 4) Mod 12) + 1 & "月")
　　　　　　　　'ブック名はD列に出す
　　　　　　　　.Range("D6").Offset(i).Value = Mid(Fname, 1, InStrRev(Fname, ".") - 1)
　　　　　　End With
　　　　Next n
　　　　Workbooks(Fname).Close False
　　　　i = i + 1
　　　　Fname = Dir()
　　Loop
　　On Error GoTo 0
　　Application.ScreenUpdating = True
　　If i > 0 Then
　　　MsgBox "終了しました。", 64
　　End If
End Sub


Private Function FormPickUP(rng As Range, ByRef myBk As String, ByVal mySh As String)
　　'引数：rng　左端の最初のセル,ブック名, シート名
　　Dim myForm As String
　　Dim Ar As Variant
　　Dim i As Long
　　Dim v As Variant
　　Dim myVal As Variant
　　Dim nm As String
　　On Error GoTo ErrHandler
　　nm = Workbooks(myBk).Name
　　
　　myForm = "C2:D2,G2,J11,K15,H8,I8,J8"
　　Ar = Split(myForm, ",")
　　For Each v In Ar
　　　　On Error Resume Next
　　　　myVal = Workbooks(myBk).Worksheets(mySh).Range(v).Value
　　　　'エラー対策
　　　　If VarType(myVal) = vbEmpty Then
　　　　　　myVal = Workbooks(myBk).Worksheets(Trim(StrConv(mySh, vbNarrow))).Range(v).Value
　　　　　　If VarType(myVal) = vbEmpty Then
　　　　　　　　myVal = Workbooks(myBk).Worksheets(Trim(StrConv(mySh, vbWide))).Range(v).Value
　　　　　　End If
　　　　End If
　　　　If VarType(myVal) = (vbVariant Or vbArray) Then
　　　　　 rng.Offset(, i).Resize(UBound(myVal, 1), UBound(myVal, 2)).Value = myVal
　　　　Else
　　　　　　rng.Offset(, i).Value = myVal
　　　　End If
　　　　On Error GoTo 0
　　　　i = i + 1
　　　　myVal = Empty
　　Next v
　　Err.Clear
　　Exit Function
ErrHandler:
　　If Err.Number <> 9 Then MsgBox Err.Number & " :エラーが発生しています。終了します。", 48: End
　　Workbooks.Open myBk
　　myBk = ActiveWorkbook.Name
　　ThisWorkbook.Activate
　　Resume
End Function

Wendy02 · Answer

補足：

後々、考えて、
Fname = Dir(MYFOLDER & "*.xls")

こういうように、ワイルドカードで拾い上げるというのは、あまりよくありませんね。シートに一覧を作って、そこからすくい上げるような書き方を本来すべきではないかと思っています。そのほうが、ミスが少ないし速いはずです。

今回書いた方法は、遅いというクレームは付くとは思いますが、全体的には、アイデアとしては悪くないのかなって思います。この「数式のすくいあげ」方式では、仮にエラーが発生しても、たぶん、エラーは最小限に食い止められるのではないか、と考えています。

しかし、ここまで来てみて、よくよく考えてみると、開いてコピーしても同じような気もしてきます。ファイルを開かずにということに対して、テクニックに走ったことが、逆におかしくしてしまったように思います。Excelの複数のファイルにアクセスする方法としては、どの方法も良い方法がありません。しかし、やはりオーソドックスな方法が一番なのでした。仮に、結果オーライでも、全体的には失敗作でした。ここまで来て、こんなことを書いてすみません。しばらく、また、考えてみます。

Wendy02 · Answer

こんばんは。

>＞今、まだ、関数側のエラー処理が徹底されていませんので、気をつけたほうがよいです。
>
>●思い通りの「月別　売掛金管理表」が作成されましたが・・・・？

思わぬ発見をしたのですが、月数のエラーというものは、発生しないことがわかりました。それは、自動的に切り替わるようです。

このマクロは、全部取得するまでには時間が掛かります。めまぐるしく動いているのですが、画面は、停止させています。
エラーは飛ばすように出来ています。

６月から、翌５月まで取るようには出来ています。1つ開いては、その月ごとのデータを取得していきます。


Sub GetDatainFolder()
　　Dim i As Long
　　Dim Fname As String
　　Dim n As Integer
　　'Const MYFOLDER As String = "C:\Documents and Settings\AAA\My Documents\販売管理\売掛金元帳\"

　　Application.ScreenUpdating = False
　　
　　Fname = Dir(MYFOLDER & "*.xls")
　　
　　On Error Resume Next
　　Do Until Len(Fname) = 0
　　　　For n = 1 To 12 '(n + 4) Mod 12 は、６月から
　　　　　　With Worksheets(n) '書き込みシートは、左から順に書き込み
　　　　　　　　FormPickUP .Range("C6").Offset(i), MYFOLDER & Fname, CStr(((n + 4) Mod 12) + 1 & "月")
　　　　　　　　.Range("C6").Offset(i).Resize(, 7).Value = _
　　　　　　　　.Range("C6").Offset(i).Resize(, 7).Value
　　　　　　　　
　　　　　　　　'ブック名はA列に出す
　　　　　　　　.Range("D6").Offset(i).Value = Mid(Fname, 1, InStrRev(Fname, ".") - 1)
　　　　　　End With
　　　　Next n
　　　　i = i + 1
　　　　Fname = Dir()
　　Loop
　　On Error GoTo 0
　　Application.ScreenUpdating = True
　　If i > 0 Then
　　　MsgBox "終了しました。", 64
　　End If
End Sub

　　
Function FormPickUP(rng As Range, ByVal myBk As String, ByVal mySh As String)
　　'引数：rng　左端の最初のセル,ブック名, シート名
　　Dim myForm As String
　　Dim Ar As Variant
　　Dim i As Long
　　Dim v As Variant
　　Dim tmp
　　On Error GoTo ErrHandler
　　tmp = Workbooks(myBk).Name
　　
　　myForm = "C2:D2,G2,J11,K15,H8,I8,J8"
　　Ar = Split(myForm, ",")
　　For Each v In Ar
　　　　rng.Offset(, i).FormulaLocal = "='[" & myBk & "]" & mySh & "'!" & v
　　　　i = i + 1
　　Next v
　　Workbooks(myBk).Close False
　　Err.Clear
　　Exit Function
ErrHandler:
　 If Err.Number <> 9 Then MsgBox "エラーが発生しています。終了します。", 48: End
　 Workbooks.Open myBk
　 myBk = ActiveWorkbook.Name
　 ThisWorkbook.Activate
　 Resume
End Function

Function getValue(ByVal Bk As String, _
　　　　　　　　　ByVal strSht As String, _
　　　　　　　　　ByVal strCell As String, _
　　　　　　　　　Optional ByVal strPath As String)
　　　　　　　　　
　If Not strCell Like "R#*C#*" Then
　 strCell = Application.ConvertFormula(strCell, xlA1, xlR1C1, xlAbsolute)
　End If
　If strPath = "" Then
　　 strPath = Application.DefaultFilePath & "\"
　End If
　　getValue = ExecuteExcel4Macro("INDEX('" & strPath & "[" & Bk & "]" & strSht & "'!" & strCell & ",1,1)")
End Function

Wendy02 · Answer

こんばんは。

答えやすい部分から。

>★ブック名はA列に出す　　→　　D6　に変更しました。
これは、了解しました。

1.　>●「月別　売掛金管理表」の
>・各シートに「月別　売掛金管理表」作成ボタンを設置し、各マクロを登録する
>●１２枚分記述しないでシート名を取得することも可能なのでしょうか。
　　　　　　&

2.　>＞今、まだ、関数側のエラー処理が徹底されていませんので、気をつけたほうがよいです。

は、連動した問題です。ふつう、掲示板のほとんどの回答者は、そんなことは心配せずに、ユーザー任せになるのですが、私は、性格的にそれが出来ないのです。

私自身が、使ってみた感じで、なんとなく、まだ、全体のエラー処理としてもしっくりとしていないのです。直す余地が残っていそうなのです。

特に、シートに対するエラー処理のことです。シート名の月の数字が、全角・半角が入ったり、せめて、そのぐらいの揺らぎは対処したいと思っています。それもうって、12枚＝12ヶ月ということには言葉に出せなかったのです。

ループする方法は、MOD演算子を使って、月数を割り出してあげればよいのですが、まだ、シート名を確実にする方法を考えていません。

>●実行しましたら「変数が定義されていません」とエラーが出ました。
>Dim tmp
>Dim MYPATH As String 　←　このように追加しました　●これで良いのでしょうか
>On Error GoTo ErrHandler

そこは変数ではなくて、本来は、定数(Const)だったはず。ただ、フォルダとして、今回のマクロの場合は、大きな違いはありません。どちらでも良いです。

Wendy02 · Answer

こんにちは。

またまた、すみません。もう、すでに専用ファイルとして、フォルダに入れましたが、長丁場のものに対しては、ごちゃごちゃしたプライベートの問題があって、ちょっと空いた時間にちょこちょこって書くことが出来なくなっていますが、必ずお答えはします。ただ、極端に集中力が落ちています。（他の回答のちょこちょこのレベルが、他人からすると、驚く量みたいらしいけれども。（^^;）

>＞実際には、書き出す場所のセルと、ブック名を、ループで、ひとつずつ与えていくわけです

このようなことです。

ただ、今、私が分かっていないのは、
111 徳川家康.xls　←の名前なのです。A列に出しておくようにしますので、そこがまずかったら、どこか探してください。

'ブック名はA列に出す
 Range("A6").Offset(i).Value =  Mid(Fname, 1, InStrRev(Fname, ".") - 1)　'拡張子は取る

Range("C6").Offset(i), myFolder & Fname, "6月"　←シート名は一致していないとけいません。全角、半角などの違いなどでエラーになる可能性があります。

今、まだ、関数側のエラー処理が徹底されていませんので、気をつけたほうがよいです。

'--------------------------------------------------

Sub GetDatainFolder()
　　Dim i As Long
　　Dim Fname As String
　　Const myFolder As String = "C:\Documents and Settings\AAA\My Documents\販売管理\売掛金元帳\"
　　 Application.ScreenUpdating = False
　　　
　　Fname = Dir(myFolder & "*.xls")
　　
　　Do Until Len(Fname) = 0
　　　　　　 FormPickUP Range("C6").Offset(i), myFolder & Fname, "6月"
　　　　　　 Range("C6").Offset(i).Resize(, 7).Value = _
　　　　　　　　Range("C6").Offset(i).Resize(, 7).Value
　　　　　　'ブック名はA列に出す
　　　　　　 Range("A6").Offset(i).Value =  Mid(Fname, 1, InStrRev(Fname, ".") - 1)　'拡張子は取る
　　　　　　 i = i + 1
　　　　 Fname = Dir()
　　Loop
　　 Application.ScreenUpdating = True
End Sub

Function FormPickUP(rng As Range, ByVal myBk As String, ByVal mySh As String)
　　'引数：rng　左端の最初のセル,ブック名, シート名
　　Dim myForm As String
　　Dim Ar As Variant
　　Dim i As Long
　　Dim v As Variant
　　Dim tmp
　　On Error GoTo ErrHandler
　　tmp = Workbooks(myBk).Name
　　
　　myForm = "C2:D2,G2,J11,K15,H8,I8,J8"
　　Ar = Split(myForm, ",")
　　For Each v In Ar
　　　　rng.Offset(, i).FormulaLocal = "='[" & myBk & "]" & mySh & "'!" & v
　　　　i = i + 1
　　Next v
　　Workbooks(myBk).Close False
　　Err.Clear
　　Exit Function
ErrHandler:
　 If Err.Number <> 9 Then MsgBox "エラーが発生しています。終了します。", 48: End
　 Workbooks.Open MYPATH & myBk
　 myBk = ActiveWorkbook.Name
　 ThisWorkbook.Activate
　 Resume
End Function

Wendy02 · Answer

補足です。まだ、本式の段階ではないかもしれませんが、コードが抜けていました。

　Next v
　　Workbooks(myBk).Close False　'←抜けている
　　Err.Clear　　　　'←抜けている
　　Exit Function
ErrHandler:
　 Workbooks.Open MYPATH & myBk
　 ThisWorkbook.Activate
　 Resume
End Function

Wendy02 · Answer

こんばんは。

一回、気を抜いてしまうと、中々戻ってこれません。それと、かなり、規模が大きすぎてしまって、言葉で追っていくのは、少し限界を感じています。どうしてもレイアウト自体が見えてこないものがあって、手が付けられなくなってしまったというのが実際のところなのです。

>参考書には参照先Workbooksを開いておかないとエラ－になると書いてありましたので、

私の考えた方式なら、そんなことはないです。

>●定数化するとはどういう意味でしょうか。
というのは、
数式で取り出したら、 
For Each c in Range(範囲）
　　c.Value = c.Value
Next c

などとして、数式を値につぶしてしまうことです。

具体的には、このように考えていました。
実際には、書き出す場所のセルと、ブック名を、ループで、ひとつずつ与えていくわけです。

------------------------------------

Sub TestMacro()
　Application.ScreenUpdating = False
　'C5 から書き出すには、
　FormPickUP Range("C5"), "徳川家康.xls", "6月"
　Range("C5").Resize(, 7).Value = Range("C5").Resize(, 7).Value
　Application.ScreenUpdating = True
End Sub
　　
Function FormPickUP(rng As Range, ByVal myBk As String, ByVal mySh As String)
　　'引数：rng　左端の最初のセル,ブック名, シート名
　　Dim myForm As String
　　Dim Ar As Variant
　　Dim i As Long
　　Dim v As Variant
　　Dim tmp
　　On Error GoTo ErrHandler
　　Const MYPATH = "C:\Documents and Settings\AAA\My Documents\販売管理\売掛金元帳\"
　　tmp = Workbooks(myBk).Name　　
　　myForm = "C2:D2,G2,J11,K15,H8,I8,J8"
　　Ar = Split(myForm, ",")
　　For Each v In Ar
　　　　rng.Offset(, i).FormulaLocal = "='[" & myBk & "]" & mySh & "'!" & v
　　　　i = i + 1
　　Next v
　　Exit Function
ErrHandler:
　 Workbooks.Open MYPATH & myBk
　 ThisWorkbook.Activate
　 Resume
End Function

Wendy02 · Answer

こんばんは。

当面、サブルーチン化するか、ユーザー定義関数にするのが良いように思っています。この件は、また、レスします。今日は、以下の件だけです。

>★処理　　　（例　6月分）
>「月別　売掛金管理表」のSheets名「6月」の作成ボタンをクリックする。
>「売掛金元帳フォルダ」の全ての得意先のデータを貼り付ける

これに関しては、答えられなかったのです。「全ての得意先のデータ」という意味自体が、１つのフォルダの中のすべてのブックのシートのことを指すのでしょうね。そうすると、必ず、数式を貼り付けた後に、必ず、定数化しないと、リンクした数式のままだと、ヘタをするとハングします。

ブック名が、シート上にあるわけですね。拡張子（xls)はなくてよいのですが。

>★その場合全ての得意先のファイルが開かれることになるのでしょうか

なるほどね。私は、開かないようにという方針でしたが、ここの掲示板の様子からすると、すべてを開いて、閉じてということでも、ご質問者さんたちは、満足しているようです。ただ、私は、あくまでも、そこら辺は、こだわりますが（^^;。。。
そういうこだわりが、質問者さんから分からない、といわれるわけですし、すべてを開くのと時間的なロス（オーバーヘッド）は、そんなに変わらないのだと思います。

>●よくは解りませんが、本来完全なデータベースを構築し必要に応じて処理すべき事例だったのでしょうか・・・。

おそらくデータベースの方が管理は楽だと思います。少し詳しくいうと、メモリの使い方が違うようですね。Excelは、何でもかんでも抱え込んでしまうので、マクロでデータを置いてあげないと、すぐに一杯になってしまうのです。個々の機能のメモリの割り振り自体は、数メガしかありません。しかし、Excelとデータベースの違いというと、表現力の自由度がExcelのほうが高いように思います。関数も豊富ですしね。

もちろん、Excelでも、ODBCやADO、また、MS-Query を使っていく方法など残されてはいるのですが、それを言ったら、まったく最初からやり直しになってしまいます。

今のExcelの状態は、つながりが、マクロでしかないので、管理としては、データベースの専門家からすれば、かなり危なっかしいものに見えます。しかし、私は、以前、そんなものをやった経験があります。

１つ決まれば、後は同じなんですが、最初から、欲張らないというか、マクロとして「作りこまない」ほうがよいです。途中で、わけが分からなくなって挫折します。

実質的に、中身のない回答ですみません。

Wendy02 · Answer

こんばんは。

>別質問にすべきならそういたします。

最初に、私は、ここのタイトルログ（受付中・締切）は、自動的に取得して、だいたい、3年分のストック（削除されたものは、こちらでも削除していますが、記録は残っています）があり、60日間は、開けるようにしています。１年前のものでも開けられるのですが、単に、60日は、管理上の理由です。質問分のストックは、大きくなりすぎるので、必要に応じて保存しています。

だから、それほど日数が過ぎなければ、まったくご心配はありません。

それから、前回の　Match 関数の不具合は、Findメソッド以外の方法で改良させることが可能ですから、ブックを開かない方法も可能になりました。ただ、検索して１つを出すというような場合にのみ有効です。

>これもExcel4Macroを使用するのですね・・・。

私は、ヘルプは違う種類のものを３つ持っています。Microsoft のダウンロードでは、１つはまだ入手可能ですが、英語です。否定的な人（たぶん調べようがないからでしょう）もいるようですが、現行では、まだ、記録マクロにも登場してきます。

>インデックス範囲が有効でないとのエラーが出ます。

これは、ブック名かシート名かどちらかが違っている場合に出る反応です。

>Sub Macro4()
>Range("C5").FormulaR1C1 = "='[徳川家康.xls]6月'!R2C3:R2C4" '得意先コード　C列

そうですね。こういうのは定番に近い書き方があります。多くの人たちは、同じような書き方をします。ただ、細かい点で分からないのは、"R2C3:R2C4" が、絶対参照になっていることですね。

C5 から、不確定だということは、この場所"R2C3:R2C4"　がずれていくのではないでしょうか？

そういう場合は、Excel4Macro よりも、数式の方が優れているとは思います。
数式で、相対参照式にして、取り出します。

Sub FormulaPasteMacro()
　　Dim myBk As String
　　Dim mySh As String
　　Dim myForm As String
　　Dim Ar As Variant　'配列の変数
　　Dim i As Long
　　Dim v As Variant
　　Dim tmp　'ダミーの変数
　　On Error GoTo ErrHandler
　　Const MYPATH = "C:\Documents and Settings\AAA\My Documents\販売管理\売掛金元帳\"
　　myBk = "徳川家康.xls"
　　mySh = "6月"
　　tmp = Workbooks(myBk).Name '開いているかチェックのためのダミー
　　
　　Application.ScreenUpdating = False
　　'相対参照式のリスト（コンマで区切る）
　　myForm = "C2:D2,G2,J11,K15,H8,I8,J8"
　　Ar = Split(myForm, ",")
　　For Each v In Ar
　　　　Range("C5").Offset(, i).FormulaLocal = "='[" & myBk & "]" & mySh & "'!" & v
　　　　i = i + 1
　　Next v
　　Application.ScreenUpdating = True
　　Exit Sub
ErrHandler:
　 'ブックが開いていないときは、開ける
　 Workbooks.Open MYPATH & myBk
　 ThisWorkbook.Activate
　 Resume
End Sub

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

こんばんは。

この回答への補足

補足2:

この回答への補足

補足：

こんばんは。

こんばんは。

こんにちは。

この回答への補足

補足です。

この回答への補足

こんばんは。

こんばんは。

この回答への補足

こんばんは。

この回答への補足

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

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