こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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

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

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

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

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

教えていただきたき事。
1.エラーの解消方法
2.下記記述の誤謬

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

投稿日時 - 2008-03-14 00:32:46

QNo.3860849

すぐに回答ほしいです

質問者が選んだベストアンサー

こんばんは。

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

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

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

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

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

投稿日時 - 2008-12-01 23:31:45

補足

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

● >来期の元帳を新規で作成するのかどうか
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月決算\管理表\"

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

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

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

投稿日時 - 2008-12-02 18:30:38

ANo.16

このQ&Aは役に立ちましたか?

25人が「このQ&Aが役に立った」と投票しています

回答(16)

ANo.15

補足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 は、6月から
      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

投稿日時 - 2008-04-17 23:15:10

補足

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

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

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

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

投稿日時 - 2008-07-07 16:43:52

お礼

Wendy02様

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

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

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

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

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

投稿日時 - 2008-04-20 13:36:05

ANo.14

補足:

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

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

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

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

投稿日時 - 2008-04-17 21:56:25

ANo.13

こんばんは。

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

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

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

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

投稿日時 - 2008-04-17 00:44:58

ANo.12

こんばんは。

答えやすい部分から。

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

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

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

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

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

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

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

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

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

投稿日時 - 2008-04-05 00:44:42

ANo.11

こんにちは。

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

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

このようなことです。

ただ、今、私が分かっていないのは、
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

投稿日時 - 2008-04-03 01:24:44

補足

Wendy02様
御回答ありがとうございます。
11回目の御回答を御願いすることになってしまい、申し訳御座いません。

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

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

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

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

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

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

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

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

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

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

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

投稿日時 - 2008-04-04 12:56:03

ANo.10

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

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

投稿日時 - 2008-03-25 02:04:53

補足

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

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

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

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

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

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

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

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

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

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

投稿日時 - 2008-03-25 13:55:00

ANo.9

こんばんは。

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

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

投稿日時 - 2008-03-25 01:56:12

ANo.8

こんばんは。

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

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

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

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

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

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

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

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

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

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

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

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

投稿日時 - 2008-03-20 00:40:34

補足

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

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

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

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

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

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

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

*3・の処理内容
 「月別 売掛金管理表」の項目行は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月のH7を表示
当月納入額   セル(G5)  ← 徳川家康.xls」の6月のH8,を表示
消費税額   セル(H5)  ← 徳川家康.xls」の6月のI8を表示
当月請求残高  セル(I5)  ← 徳川家康.xls」の6月のJ8を表示
以下
  6行目  112 豊臣秀吉.xlsのデータ
        ・・・・・・・・
180行目  200 織田信長.xlsのデータ
        ・・・・・・・・
*月中一度も売上がなっかた得意先も該当項目に全て 0 を表示する
5・得意先コード順に並べ替え

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

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

投稿日時 - 2008-03-20 15:00:43

ANo.7

こんばんは。

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

最初に、私は、ここのタイトルログ(受付中・締切)は、自動的に取得して、だいたい、3年分のストック(削除されたものは、こちらでも削除していますが、記録は残っています)があり、60日間は、開けるようにしています。1年前のものでも開けられるのですが、単に、60日は、管理上の理由です。質問分のストックは、大きくなりすぎるので、必要に応じて保存しています。

だから、それほど日数が過ぎなければ、まったくご心配はありません。

それから、前回の Match 関数の不具合は、Findメソッド以外の方法で改良させることが可能ですから、ブックを開かない方法も可能になりました。ただ、検索して1つを出すというような場合にのみ有効です。

>これもExcel4Macroを使用するのですね・・・。

私は、ヘルプは違う種類のものを3つ持っています。Microsoft のダウンロードでは、1つはまだ入手可能ですが、英語です。否定的な人(たぶん調べようがないからでしょう)もいるようですが、現行では、まだ、記録マクロにも登場してきます。

>インデックス範囲が有効でないとのエラーが出ます。

これは、ブック名かシート名かどちらかが違っている場合に出る反応です。

>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

投稿日時 - 2008-03-19 00:56:32

補足

Wendy02様

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

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

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

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

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

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

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

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

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

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

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

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

投稿日時 - 2008-03-19 12:31:51

ANo.6

こんばんは。

一応、私もそれなりに、今おやりになっているものの内容は想像できますが、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を書いてあげる必要があります。

投稿日時 - 2008-03-18 01:05:53

補足

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月(Sheet1) 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月」の作成ボタンをクリックする。
「売掛金元帳フォルダ」の全ての得意先のデータを貼り付ける

毎月同様処理を行う

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

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

投稿日時 - 2008-03-18 15:55:29

お礼

Wendy02様
今晩は。

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

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

とんでも御座いません。

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

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

さすがに、疲れました。

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

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

取敢えず御礼まで。

おやすみなさい。

投稿日時 - 2008-03-18 01:49:57

ANo.5

こんばんは。

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

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

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

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


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

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

>If IsNumeric(koudo.Text) Then
>' CODE = CLng(koudo.Text) ' (B)・ここは 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.早く書きたかったのですが、サイトにアクセスがしばらく出来ませんでした。

投稿日時 - 2008-03-17 00:58:19

補足

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

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

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

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

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

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

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

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

投稿日時 - 2008-03-17 22:39:46

ANo.4

こんばんは。

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

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

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

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

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

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

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

投稿日時 - 2008-03-15 23:58:44

補足

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

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

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

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

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

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

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

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

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

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

投稿日時 - 2008-03-16 16:16:29

お礼

Wendy02様
御免なさい。
お礼ではないのですが、下記添付するのを忘れましたので送ります
Private Sub koudo_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim CODE As Variant
i = 0
Set WS1 = Worksheets("商品登録") ' (A)・これは不要ですか
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) ' (B)・ここは 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)
 ・・・ (1000文字に引掛りましたので一部省略 )・・・

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

投稿日時 - 2008-03-16 20:19:29

ANo.3

こんにちは。

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

投稿日時 - 2008-03-14 15:32:39

補足

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

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

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

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

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

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

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

■得意先台帳の構成(Sheetは2枚です)
得意先登録.xls  Sheet1の名称は 「得意先登録」
           Sheet2の名称は 「メモ」 です
・列項目
 [新規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] は全く同じです。
(新規登録時のダイアログボックスを兼用できますか?)

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

投稿日時 - 2008-03-14 19:16:56

お礼

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

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

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

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

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

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

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

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

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

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

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

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

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

oguno

投稿日時 - 2008-03-15 18:31:33

ANo.2

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

基本的な書き方ですが、ふつうは、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自身には、予約語のエラーは、ほとんど存在しませんので、何でもありです。

投稿日時 - 2008-03-14 10:37:40

補足

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

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

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

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

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

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

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

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

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

投稿日時 - 2008-03-14 13:39:54

ANo.1

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

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

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

投稿日時 - 2008-03-14 02:54:50

あなたにオススメの質問