ＶＢＡ 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.15

Wendy02

補足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様

２週間ぶりにパソコンを開きました。

４月５日のご回答に御礼も申し上ないまま失礼し申し訳御座いません。

その間も、私の為にお心遣いいただき御回答賜りました事深く感謝いたします。

体調回復次第勉強させていただきます。

勝手ながら事情御賢察の上御容赦のほど御願申し上げます。
取敢えず御礼まで。

補足

Wendy02様
ご無沙汰いたし申し訳御座いません。
あれから、早三ヶ月が過ぎてしまいました。
花期は既に過ぎました庭の娑羅の木を眺めました時のメモです。

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

三月も放置していたにもかかわらず、Gooさんから何のご指摘も無かったのは、Wendy02様の御配慮があったものと感謝申し上げます。
このまま締め切りをさせていただくのは、心残りがございます。
それは、当期の管理表（売掛金管理表及び買掛金管理表）の期末シート（5月シート）の残高を、来期の元帳（売掛金元帳・買掛金元帳）の６月シートのJ11に表示するところまで作成したかったからです。

★考えていました事
１．御指導いただきましたように管理表を作成する
２．管理表の5月シートに「残高移行」ボタンを設置する
３．「残高移行」ボタンをクリックすることにより下記処理をする。
　・管理表の5月シートの社名(D6：D205)と、同じ社名の売掛金元帳ファイルがあるか検索し、あれば売掛金元帳ファイルのJ11に管理表の残高（J6:J205)を表示する
　・なければ、「MsgBox "元帳なし・111 徳川家康.xls"、vbOKOnly」を表示し、「OK]で検索を続ける

まるなげの形になってしまいますが、宜しく御願申し上げます。

回答No.14

Wendy02

補足：

後々、考えて、
Fname = Dir(MYFOLDER & "*.xls")

こういうように、ワイルドカードで拾い上げるというのは、あまりよくありませんね。シートに一覧を作って、そこからすくい上げるような書き方を本来すべきではないかと思っています。そのほうが、ミスが少ないし速いはずです。

今回書いた方法は、遅いというクレームは付くとは思いますが、全体的には、アイデアとしては悪くないのかなって思います。この「数式のすくいあげ」方式では、仮にエラーが発生しても、たぶん、エラーは最小限に食い止められるのではないか、と考えています。

しかし、ここまで来てみて、よくよく考えてみると、開いてコピーしても同じような気もしてきます。ファイルを開かずにということに対して、テクニックに走ったことが、逆におかしくしてしまったように思います。Excelの複数のファイルにアクセスする方法としては、どの方法も良い方法がありません。しかし、やはりオーソドックスな方法が一番なのでした。仮に、結果オーライでも、全体的には失敗作でした。ここまで来て、こんなことを書いてすみません。しばらく、また、考えてみます。

回答No.13

Wendy02

こんばんは。

>＞今、まだ、関数側のエラー処理が徹底されていませんので、気をつけたほうがよいです。
>
>●思い通りの「月別　売掛金管理表」が作成されましたが・・・・？

思わぬ発見をしたのですが、月数のエラーというものは、発生しないことがわかりました。それは、自動的に切り替わるようです。

このマクロは、全部取得するまでには時間が掛かります。めまぐるしく動いているのですが、画面は、停止させています。
エラーは飛ばすように出来ています。

６月から、翌５月まで取るようには出来ています。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

回答No.12

Wendy02

こんばんは。

答えやすい部分から。

>★ブック名はA列に出す　　→　　D6　に変更しました。
これは、了解しました。

1.　>●「月別　売掛金管理表」の
>・各シートに「月別　売掛金管理表」作成ボタンを設置し、各マクロを登録する
>●１２枚分記述しないでシート名を取得することも可能なのでしょうか。
　　　　　　&

2.　>＞今、まだ、関数側のエラー処理が徹底されていませんので、気をつけたほうがよいです。

は、連動した問題です。ふつう、掲示板のほとんどの回答者は、そんなことは心配せずに、ユーザー任せになるのですが、私は、性格的にそれが出来ないのです。

私自身が、使ってみた感じで、なんとなく、まだ、全体のエラー処理としてもしっくりとしていないのです。直す余地が残っていそうなのです。

特に、シートに対するエラー処理のことです。シート名の月の数字が、全角・半角が入ったり、せめて、そのぐらいの揺らぎは対処したいと思っています。それもうって、12枚＝12ヶ月ということには言葉に出せなかったのです。

ループする方法は、MOD演算子を使って、月数を割り出してあげればよいのですが、まだ、シート名を確実にする方法を考えていません。

>●実行しましたら「変数が定義されていません」とエラーが出ました。
>Dim tmp
>Dim MYPATH As String 　←　このように追加しました　●これで良いのでしょうか
>On Error GoTo ErrHandler

そこは変数ではなくて、本来は、定数(Const)だったはず。ただ、フォルダとして、今回のマクロの場合は、大きな違いはありません。どちらでも良いです。

回答No.11

Wendy02

こんにちは。

またまた、すみません。もう、すでに専用ファイルとして、フォルダに入れましたが、長丁場のものに対しては、ごちゃごちゃしたプライベートの問題があって、ちょっと空いた時間にちょこちょこって書くことが出来なくなっていますが、必ずお答えはします。ただ、極端に集中力が落ちています。（他の回答のちょこちょこのレベルが、他人からすると、驚く量みたいらしいけれども。（^^;）

>＞実際には、書き出す場所のセルと、ブック名を、ループで、ひとつずつ与えていくわけです

このようなことです。

ただ、今、私が分かっていないのは、
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様
御回答ありがとうございます。
１１回目の御回答を御願いすることになってしまい、申し訳御座いません。

＞またまた、すみません。

★とんでも御座いません。
謝らなければならないのは私の方です。
知識も技術も無いのに勉強の為とは言え、どんどん課題を膨らませてしまい御迷惑をお掛けしています。
御回答いただくと、ジャア、こんな事も出来るのだろうかと、最初の質問からだんだん逸脱してしまいます。
ほとんど、”マルナゲ質問”に御回答いただいている形になっていますが、御回答いただきました内容については、本などで意味を確認したりしながら、私なりに一生懸命咀嚼して勉強させていただいております。

＞ただ、極端に集中力が落ちています。（他の回答のちょこちょこのレベルが、他人からすると、驚く量みたいらしいけれども

★2005/3/13に登録されてから、まる３年、回答数7043件、年間で約２４００件、１日約７件、懇切丁寧に、あらゆるカテゴリで・・・・。
あらゆる分野の知識・その集中力・その体力等々、神技としか思えません。
叶うことならば、生涯に一度でも、”神様”にお会いする機会を得たいものと、今痛切に感じています。
また、このような出会いの場所を設けて下さった”goo”様に感謝しております。

＞111 徳川家康.xls　←の名前なのです。A列に出しておくようにしますので、そこがまずかったら、どこか探してください。

★ブック名はA列に出す　　→　　D6　に変更しました。

＞Range("C6").Offset(i), myFolder & Fname, "6月"　←シート名は一致していないとけいません。
★質問(次のようにすれば良いのでしょうか、御指導お願い致します。）
●Module1に
・１２シート（６月～１２月～翌年５月）ありますので　「Sub GetDatainFolder()」　の部分のシート名を各月のシート名に変更し１２枚分記述する。
・「Function FormPickUP(rng As Range, ByVal myBk As String, ByVal mySh As String)」　の部分は最終部に一回記述する。

●「月別　売掛金管理表」の
・各シートに「月別　売掛金管理表」作成ボタンを設置し、各マクロを登録する
●１２枚分記述しないでシート名を取得することも可能なのでしょうか。

●実行しましたら「変数が定義されていません」とエラーが出ました。
Dim tmp
Dim MYPATH As String 　←　このように追加しました　●これで良いのでしょうか
On Error GoTo ErrHandler

＞今、まだ、関数側のエラー処理が徹底されていませんので、気をつけたほうがよいです。

●思い通りの「月別　売掛金管理表」が作成されましたが・・・・？

回答No.10

Wendy02

補足です。まだ、本式の段階ではないかもしれませんが、コードが抜けていました。

　Next v
　　Workbooks(myBk).Close False　'←抜けている
　　Err.Clear　　　　'←抜けている
　　Exit Function
ErrHandler:
　 Workbooks.Open MYPATH & myBk
　 ThisWorkbook.Activate
　 Resume
End Function

補足

Wendy02様
御回答ありがとうございます。
深夜の御指導ありがとうございます。
約一時間後に再度御指導くださっていますのは、お心に留めていただいているからと感謝申し上げます。
こんな質問に係わらせてしまい、御迷惑をお掛けしてます事、御詫び申し上げます。

>言葉で追っていくのは、少し限界を感じています。

●出来るだけ客観的にと思いながら書いていますが、表現力の無さ故御迷惑をお掛けしています。

>>●定数化するとはどういう意味でしょうか。
今までは、コピー/値の貼付で処理していました。

★今回御指導いたいだいたマクロについて

徳川家康分は考えている通りに完璧に処理できました。

この状態で、「売掛金元帳」に有る得意先の内容が　６行目以降順次表示出来れば完成です。

＞実際には、書き出す場所のセルと、ブック名を、ループで、ひとつずつ与えていくわけです
●試行錯誤重ねましたがどうしても出来ませんでした。
最終的にはループの張る位置すらこんがらがってしまっています。

●御願い
何とか引き続き御指導いたける事を願っておりますが、これ以上の指導は無理だとお考えの場合はその旨だけは連絡ください

御迷惑をお掛けしています事、御詫び申し上げます。
宜しく御願いいたします。

回答No.9

Wendy02

こんばんは。

一回、気を抜いてしまうと、中々戻ってこれません。それと、かなり、規模が大きすぎてしまって、言葉で追っていくのは、少し限界を感じています。どうしてもレイアウト自体が見えてこないものがあって、手が付けられなくなってしまったというのが実際のところなのです。

>参考書には参照先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

回答No.8

Wendy02

こんばんは。

当面、サブルーチン化するか、ユーザー定義関数にするのが良いように思っています。この件は、また、レスします。今日は、以下の件だけです。

>★処理　　　（例　6月分）
>「月別　売掛金管理表」のSheets名「6月」の作成ボタンをクリックする。
>「売掛金元帳フォルダ」の全ての得意先のデータを貼り付ける

これに関しては、答えられなかったのです。「全ての得意先のデータ」という意味自体が、１つのフォルダの中のすべてのブックのシートのことを指すのでしょうね。そうすると、必ず、数式を貼り付けた後に、必ず、定数化しないと、リンクした数式のままだと、ヘタをするとハングします。

ブック名が、シート上にあるわけですね。拡張子（xls)はなくてよいのですが。

>★その場合全ての得意先のファイルが開かれることになるのでしょうか

なるほどね。私は、開かないようにという方針でしたが、ここの掲示板の様子からすると、すべてを開いて、閉じてということでも、ご質問者さんたちは、満足しているようです。ただ、私は、あくまでも、そこら辺は、こだわりますが（^^;。。。
そういうこだわりが、質問者さんから分からない、といわれるわけですし、すべてを開くのと時間的なロス（オーバーヘッド）は、そんなに変わらないのだと思います。

>●よくは解りませんが、本来完全なデータベースを構築し必要に応じて処理すべき事例だったのでしょうか・・・。

おそらくデータベースの方が管理は楽だと思います。少し詳しくいうと、メモリの使い方が違うようですね。Excelは、何でもかんでも抱え込んでしまうので、マクロでデータを置いてあげないと、すぐに一杯になってしまうのです。個々の機能のメモリの割り振り自体は、数メガしかありません。しかし、Excelとデータベースの違いというと、表現力の自由度がExcelのほうが高いように思います。関数も豊富ですしね。

もちろん、Excelでも、ODBCやADO、また、MS-Query を使っていく方法など残されてはいるのですが、それを言ったら、まったく最初からやり直しになってしまいます。

今のExcelの状態は、つながりが、マクロでしかないので、管理としては、データベースの専門家からすれば、かなり危なっかしいものに見えます。しかし、私は、以前、そんなものをやった経験があります。

１つ決まれば、後は同じなんですが、最初から、欲張らないというか、マクロとして「作りこまない」ほうがよいです。途中で、わけが分からなくなって挫折します。

実質的に、中身のない回答ですみません。

補足

Wendy02様
御回答ありがとうございます。

＞実質的に、中身のない回答ですみません。
●とんでも御座いません。
質問の表現が的確でなく毎回毎回補足質問になり申し訳御座いません。
自分自身の為に再度整理し直してみましたので御一読いただき御指導のほど宜しく御願いいたします。

●「販売管理フォルダ」
　　　　「売掛金元帳フォルダ」
　　　　　　　　「月別　売掛金管理表.xls」　→　Sheets（6月・7月・・・5月）　計12シート

　　　　　　　　111 徳川家康.xls　→　Sheets（6月・7月・・・5月）　計12シート　←　締切日毎月２５日
　　　　　　　　112 豊臣秀吉.xls　→　Sheets（6月・7月・・・5月）　計12シート　←　締切日毎月２０日
　　　　　　　　 　・・・・・・・.xls 　→　Sheets（6月・7月・・・5月）　計12シート
　　　　　　　　200 織田信長.xls　→　Sheets（6月・7月・・・5月）　計12シート　←　締切日毎月月末
　　　　　　　　 　・・・・・・・.xls　 →　Sheets（6月・7月・・・5月）　計12シート
　　　　「買掛金元帳フォルダ」

＊Sheetsは、５月決算と仮定して、今年の６月から翌年の５月と配列
＊「月別　売掛金管理表.xls」作成処理をを考えた場合、「月別　売掛金管理表.xls」を「売掛金元帳フォルダ」に置く事が適切なのかどうか？

>★処理
●処理手順　１　　　（例　「111 徳川家康.xls」の6月分シート）
１・「111 徳川家康.xls」の日々の売上データを入力する。
２・「納品書」を作成・印刷する　←　未完成
３・「111 徳川家康.xls」の６月分（5月２６日から６月２５日）の全ての売上データの入力が完了したら。
４・「締切日更新」をする　←　作成済
　　　　＊一部分、リンクが貼ってありますので全てリンクを切り値にしています。
５．「請求書」を作成・印刷する　←　作成済
６・「売掛金元帳」を作成・印刷する　←　作成済
７・全ての得意先同様処理

●処理手順　２　《月末処理》　　（例　６月分の処理）
・全ての得意先の「締切日更新」が終了したら月末処理をする
＊月中一度も売上がなっかた得意先は「締切日更新」はされていない。
１・「月別　売掛金管理表」のSheets名「6月」を開く。
２・「月別　売掛金管理表」のSheets名「6月」に設置してある｛作成ボタン１」をクリックする。
３・「売掛金元帳フォルダ」の全ての得意先のSheets６月分のデータを「値」として貼り付ける

＊３・の処理内容
　「月別　売掛金管理表」の項目行は4行目、データ行は5行目から始まり得意先の増減により一定していない。
得意先コード　 　セル（C4)
得意先名　 　セル（D4)
前月請求残高　　セル（E4)
当月入金額　　 セル（F4)
当月納入額　 　セル（G4)
消費税額　　 セル（H4)
当月請求残高　　セル（I4)

「月別　売掛金管理表」のデータ行は5行目　　（例　「111 徳川家康.xls」の6月分シート）
得意先コード　 　セル（C5)　　←　徳川家康.xls」の6月のC2:D2を表示
得意先名　 　セル（D5)　　←　徳川家康.xls」の6月のG2を表示
前月請求残高　　セル（E5)　　←　徳川家康.xls」の6月のJ11を表示
当月入金額　　 セル（F5)　　←　徳川家康.xls」の6月のH７を表示
当月納入額　 　セル（G5)　　←　徳川家康.xls」の6月のH8,を表示
消費税額　　 セル（H5)　　←　徳川家康.xls」の6月のI8を表示
当月請求残高　　セル（I5)　　←　徳川家康.xls」の6月のJ8を表示
以下
　　６行目　　112 豊臣秀吉.xlsのデータ
　　　　　　　　・・・・・・・・
１８０行目　　200 織田信長.xlsのデータ
　　　　　　　　・・・・・・・・
＊月中一度も売上がなっかた得意先も該当項目に全て　0　を表示する
５・得意先コード順に並べ替え

＞>★その場合全ての得意先のファイルが開かれることになるのでしょうか
＞私は、あくまでも、そこら辺は、こだわりますが（^^;。。。　　・・・・・・
NO5の補足質問で御指導をお願い致しましたように可能ならば参照ブックは開かないで処理が出来ればと今も考えております。
参考書には参照先Workbooksを開いておかないとエラ－になると書いてありましたので、
Private Sub Workbook_Open()
Workbooks.Open Filename:= _
C:\Documents and Settings\AAA\My Documents\販売管理　台帳登録\得意先登録.xls
としました。

＞定数化しないと
●定数化するとはどういう意味でしょうか。

回答No.7

Wendy02

こんばんは。

>別質問にすべきならそういたします。

最初に、私は、ここのタイトルログ（受付中・締切）は、自動的に取得して、だいたい、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

補足

Wendy02様

再三にわたる深夜の御指導感謝いたします。

＞それほど日数が過ぎなければ、まったくご心配はありません。
●ありがとうございます。

＞インデックス範囲が有効でないとのエラーが出ます。
＞これは、ブック名かシート名かどちらかが違っている場合に出る反応です。
●後程確認いたします。

＞myForm = "C2:D2,G2,J11,K15,H8,I8,J8"
●K15は入金合計行ですが、データ件数次第で固定していないので、H７に修正し固定にしました。
C2:D2,G2,J11,H7,H8,I8,J8 はどの得意先のどの月も同じセルとなります。

＞C5 から、不確定だということは
●得意先の増減により「月別　売掛金管理表.xls」の行数が一定していないという意味です。

●御指導のマクロ動作確認
111 徳川家康.xlsのデータは「月別　売掛金管理表.xls」の所定のセルにリンクしました。

前回、処理について下記のようなお願いを致しましたが可能なのでしょうか
★処理　　　（例　6月分）
「月別　売掛金管理表」のSheets名「6月」の作成ボタンをクリックする。
「売掛金元帳フォルダ」の全ての得意先のデータを貼り付ける
毎月同様処理を行う

★処理について再整理　　　（例　6月分）
１・「月別　売掛金管理表」のSheets名「6月」上に、設置した「作成ボタン」をクリックする。
２・「売掛金元帳フォルダ」の全ての得意先のデータを表示させる（貼り付又はリンク）
　「月別　売掛金管理表」の項目行は4行目　データ行は5行目から始まり得意先の増減により一定していません。

　　　　　４行目　項目名
　　　　　５行目　111 徳川家康.xlsのデータ
　　　　　６行目　112 豊臣秀吉.xlsのデータ
　　　　　　　　　　・・・・・・・・・
　　　１８０行目　200 織田信長.xlsのデータ
　　　　　　　　　　・・・・・・・・・
★その場合全ての得意先のファイルが開かれることになるのでしょうか

●よくは解りませんが、本来完全なデータベースを構築し必要に応じて処理すべき事例だったのでしょうか・・・。

お心煩わす勝手なお願いばかりになってしまい本当に申し訳ございません。

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

回答No.6

Wendy02

こんばんは。

一応、私もそれなりに、今おやりになっているものの内容は想像できますが、oguno様の完成への集中力とかスピードとか、私は、さすがに、自分の力の不足を感じてしまいますね。逆の立場だったら、とても、私のような飲み込みの悪い人間には、同じようには出来ません。

エラーになるのは、そのブックのデータを使うということでしょうか？
やはり、開けて使うのが楽かもしれません。

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

せっかくですから、サンプルで試してみましょうか？カビの生えたようなワザですが、なかなか思いつかないと思います。

Sub VerFourTecnique()
　Dim What As String
　Dim Ret As Variant
　What = """z"""　'検索データ

　'R1C1 方式で書く必要があります。
　Ret = ExecuteExcel4Macro("VLOOKUP(" & What & ",'C:\Documents and Settings\AAA\My Documents\販売管理　台帳登録\[仕入先登録.xls]Sheet1'!R1C1:R1000C4,2,0)")
　If Not IsError(Ret) Then
　　 MsgBox Ret
　Else
　　 MsgBox "該当するデータがありません", 48

　End If
End Sub

開いていないくても、このようにしてデータは取れます。Match も当然使えます。そうでない方法としては、ADOを使う方法があります。Excelシートに対して検索する、SQLを書いてあげる必要があります。

お礼

Wendy02様
今晩は。

身勝手お願いを致しましたのに、またまた深夜御回答いただき、ただただ感謝申し上げるのみで御座います。

＞完成への集中力とかスピードとか、私は、さすがに、自分の力の不足を感じてしまいますね。逆の立場だったら、とても、私のような飲み込みの悪い人間には、同じようには出来ません。

とんでも御座いません。

先生のような方がいて下さるので頑張っているだけです。

毎日、朝から今頃まで本やヘルプを漁っていますが進歩無です。

さすがに、疲れました。

明日御指導いただきました内容を勉強させていただきます。

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

取敢えず御礼まで。

おやすみなさい。

補足

Wendy02様

御指導いただきました内容を勉強させていただきましたが、どうしてもインデックス範囲が有効でないとのエラーが出ます。

これもExcel4Macroを使用するのですね・・・。
印刷枚数を事前に知りたくて、本に記述されていましたExcel4Macro「get.document]を使用しています。
しかし、理解せず丸写しの為、今回御指導いただいたマクロを何処に張付けるのから始めました（この程度です）。

C:\Documents and Settings\AAAの　AAA　は直しました
今回も半日以上費やしましたが、私の処理の何処が間違っているのか、判らず結果はエラーが出てしまい、そこまでです。

●しかし、折角御指導いただいたのですから後日もう一度整理し挑戦してみます。

＞やはり、開けて使うのが楽かもしれません。
★おっしゃられた通りでした。

昨夜から、元帳のデータを使用して「月別　売掛金管理表」の作成を始めました。

★売掛金元帳の構成
C:\Documents and Settings\AAA\My Documents\販売管理\売掛金元帳\徳川家康.xls
売掛金元帳フォルダに
111 徳川家康.xls
112 豊臣秀吉.xls
・・・・(得意先数不確定です)
200 織田信長.xls
月別　売掛金管理表.xls

★月別　売掛金管理表.xlsの構成
ワークシートの構成
6月（Sheet１）　7月（Sheet2）　・・・・・　　5月（Sheet12）
項目行　4行目　　　　データ行　5行目から不確定

下記は自動マクロで作成したものです。
Sub Macro4()
Range("C5").FormulaR1C1 = "='[徳川家康.xls]6月'!R2C3:R2C4" '得意先コード　C列

Range("D5").FormulaR1C1 = "='[徳川家康.xls]6月'!R2C7" '得意先名　D列

Range("E5").FormulaR1C1 = "='[徳川家康.xls]6月'!R11C10" '前月請求残高　E列

Range("F5").FormulaR1C1 = "='[徳川家康.xls]6月'!R15C11" '当月入金額　F列

Range("G5").FormulaR1C1 = "='[徳川家康.xls]6月'!R8C8" '当月納入額　G列

Range("H5").FormulaR1C1 = "='[徳川家康.xls]6月'!R8C9" '消費税額　H列

Range("I5").FormulaR1C1 = "='[徳川家康.xls]6月'!R8C10" '当月請求残高　I列

Range("D11").Select
End Sub

★処理　　　（例　6月分）
「月別　売掛金管理表」のSheets名「6月」の作成ボタンをクリックする。
「売掛金元帳フォルダ」の全ての得意先のデータを貼り付ける

毎月同様処理を行う

以上のような事を考えておりますがとても自分で作成する事は無理なようです。

お教えください。
率直に御願い申し上げます。
ただ、別質問にすべきならそういたします。