[[20110128162807]]　『マクロでエラー』（FA）　ページの最後に飛ぶ

『マクロでエラー』（FA）

 いつもお世話になっております。
 以前ご質問させて頂いたのですが、ご回答が無かったのでもう一度させて頂きます。
 また自分自身で原因を追求してわかったことがありますのでご報告致します。

 下記は前回の質問です。

 下記のような製品リストがあります。

    A       B    　C　　　　D　　    E・・・
 1 番号  客先名 製品番号　品番　  製品名・・・
 2  1　　　A     1111      -      パイプA
 3  2      A     1135      -　　　パイプB
 4  3      B     A165A    K19　　 ケース
 5  5      C     P35-11A  SDA164　テレビ台

 別のブックで下記のような受入リストがあります。

       A       B    　　 C　　     D　　　　E　　   D　　    E   ・・・
 1 製造番号  受取日 客先伝票番号 客先名　製品番号　品番　  製品名・・・
 2  KT1001　　1/27    S1675　　　　B　　　A165A    K19　　 ケース
 3  KT1002    1/28    867-16　　　 A　　　1111      -      パイプA
 4  KT1003    1/28    867-16　　　 A　　　1135      -　　　パイプB
 5  KT1004    1/28    11-216S　　　C　　　P35-11A  SDA164　テレビ台

 受入リストはマクロで製品リストからデータを参照しています。
 客先名をプルダウンで選択すると、製造番号・品番・製品名までその客先名の製品だけをプルダウンできるようになっています。
 プルダウンは、客先名→製品番号→品番→製品名の順番で選択肢し、製品を絞りこみます。

 問題は受入リストで特定の客先（以下D社とします。）をプルダウンし、
 製品番号もプルダウンした後に保存をかけるとエラーが発生します。
 エラー内容は『問題が発生したため、マイクロソフトオフィスエクセルを終了します』と出て、
 エクセルの再起動、エラー報告を送信するかしないかの選択ができます。

 製品リストの客先名は60社あり今後どんどん増える予定です。
 製品リストで一番製品の多いのがD社です。654製品。
 製品リストでD社のデータを20個程度消去すると保存できます。
 特定の製品を消去するとエラーがなくなるという感じではなく、
 データの容量？が問題のような気がします。
 しかしハッキリと原因がマクロなのか、製品リストなのか、受入リストなのかが特定できません。

 作業環境はネットワーク上で、タイ語版エクセルを使用しています。
 しかしローカル上、日本語版エクセルで確認したところ同様の問題が発生しました。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

  If Target.Count > 1 Then Exit Sub
  Select Case Target.Column
    Case 4: GetList Target, 1
    Case 5: GetList Target, 2
    Case 6: GetList Target, 3
    Case 7: GetList Target, 4
    Case 10: GetList Target, 5
    Case Else: Exit Sub
  End Select
  End Sub

  Private Sub GetList(myRng As Range, ptn As Long)
  Dim wb As Workbook, tbl As Variant, myKey As Variant, i As Long
  Const myFile As String = "02_Parts_List.xls"  '製品リストのブック名
  Const myPath As String = "D:\Data_Center\10 Date Center\"        '製品リストの保存パス
  Const mySheet As String = "Parts_List"         '製品リストのシート名
  On Error Resume Next
  Set wb = Workbooks(myFile)
  On Error GoTo 0
  If wb Is Nothing Then
    Set wb = Workbooks.Open(myPath & myFile)
    ThisWorkbook.Activate
  End If
  tbl = wb.Worksheets(mySheet).Range("A2").CurrentRegion.Value
  With CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(tbl)
      Select Case ptn
        Case 1
          .Item(tbl(i, 2)) = ""
        Case 2
          If tbl(i, 2) = myRng.Offset(, -1).Value Then
            .Item(tbl(i, 3)) = ""
          End If
        Case 3
          If tbl(i, 2) = myRng.Offset(, -2).Value And _
             tbl(i, 3) = myRng.Offset(, -1).Value Then
            .Item(tbl(i, 4)) = ""
          End If
        Case 4
          If tbl(i, 2) = myRng.Offset(, -3).Value And _
             tbl(i, 3) = myRng.Offset(, -2).Value And _
             tbl(i, 4) = myRng.Offset(, -1).Value Then
            .Item(tbl(i, 5)) = ""
          End If
        Case 5
          If tbl(i, 2) = myRng.Offset(, -5).Value And _
             tbl(i, 3) = myRng.Offset(, -4).Value And _
             tbl(i, 4) = myRng.Offset(, -3).Value And _
             tbl(i, 5) = myRng.Offset(, -2).Value Then
            .Item(tbl(i, 7)) = ""
          End If
      End Select
    Next i
    myKey = .Keys
  End With
  With myRng.Validation
    .Delete
    Select Case UBound(myKey)
      Case Is > 0: .Add Type:=xlValidateList, Formula1:=Join(myKey, ",")
      Case 0:      .Add Type:=xlValidateList, Formula1:=myKey(0)
    End Select
  End With
  End Sub

 どうかご教授の方宜しくお願い致します。

 原因追求のため、新規ブックで下記のような製品リストを作成しました。

      A       B     　    C　　　　     D　　      E
 1   番号  客先名      製品番号　      品番　    製品名
 2  　1　　 AAA 　 ASA1110001           -       SDAA00001
 3    2     AAA    ASA1110002           -       SDAA00002
 4    3     AAA    ASA1110003           -       SDAA00003
 .
 .
 .
 .
 746　745　 AAA    ASA1110745           -       SDAA00745    　　
 747　746　 BBB    TADA11100001        SSA      OKKKA1650001
 748  747　 BBB    TADA11100002        SSA      OKKKA1650002   
 749  748   BBB    TADA11100003        SSA      OKKKA1650003   
 .
 .
 .
 1377 1376  BBB    TADA11100631        SSA      OKKKA1650631
 1378 1377  CCC    YSAYHSY00001100001  ARV      KIDJUAAA1000001
 1379 1378  CCC    YSAYHSY00001100002  ARV      KIDJUAAA1000002  
 1380 1379  CCC    YSAYHSY00001100003  ARV      KIDJUAAA1000003  
 .
 .
 .
 1808 1807  CCC    YSAYHSY00001100431  ARV      KIDJUAAA1000431
 1809 1808  DDD    A1                  A        B1
 1810 1809  DDD    A2                  A        B2
 1811 1810  DDD    A3                  A        B3
 .
 .
 .
 3309 3308  DDD    A1501               A        B1501

 上記製品リストで
 AAA社 745行
 BBB社 631行
 CCC社 431行
 DDD社 1501行
 となっています。この行数だとエラーはでません。

 各社とも行を追加(1行)製品リストを入力し、 受注リストで客先名をプルダウンで選択、製品番号をプルダウンしようとセルを選択すると、

 実行時エラー1004
 アプリケーション定義またはオブジェクト定義のエラーです。
 となります。

 デバックを見ると矢印の部分が問題のようです。

 →     Case Is > 0: .Add Type:=xlValidateList, Formula1:=Join(myKey, ",")
  　    Case 0:      .Add Type:=xlValidateList, Formula1:=myKey(0)
    End Select
  End With
  End Sub

 製品リストの製品番号の文字数が少なければ、追加できる行が多いようです。

 原因はマクロのように思うのですが、どのように修正すればよいのか検討が付きません。
　ご教授宜しくお願い致します。

 製作エクセル、Excel2007(日本語版)
 使用エクセル、Excel2007(タイ語版)
 製作ＯＳ、ＸＰ(日本語版)
 使用ＯＳ、ＸＰ(タイ語版)

 2003で検証しましたので、2007とは結果が違うと思いますが、
 Sub Macro1()
     Dim i As Long, i2 As Long
     Dim myStr1 As String
     Dim myStr2 As String
     myStr1 = "A0"
     On Error GoTo errhdl
     For i = 1 To 1000
         i2 = i
         myStr2 = ",A" & i
         myStr1 = myStr1 & myStr2
         With Selection.Validation
             .Delete
             .Add Type:=xlValidateList, Formula1:=myStr1
         End With
     Next i
     Exit Sub
errhdl:
     MsgBox i2
     MsgBox Err.Number
     MsgBox Len(myStr1)
 End Sub
　
例えば、上記のようなマクロを走らせますと、
i2 = 204
Err.Number = 1004
Len(myStr1) = 914 のような結果が得られました。
　
203回のループを実行するとマクロはエラートラップしませんが、
リスト表示は不完全でした。
Formula1　に直接格納する文字数に制限がある可能性がある、と推測します。
こちらの環境では2003で最大916文字までしか設定できませんでしたが、
この推測が正しいかは自信がありません。
　
リストをシートに作成し、「元の値」をそのリストへのセル参照にすることで
回避できると推測します。
(みやほりん)(-_∂)b

 みやほりん様

 ご回答、ご検証ありがとうございます。
 3週間ほどこの問題で行き詰っていたところでした。

 ＞Formula1　に直接格納する文字数に制限がある可能性がある、と推測します。
 初心者の私でも分かりやすいご丁寧な解説ありがとうございます。
 私も調査して、文字数に制限があるのでは？と感じていました。
 2007ではリスト表示がA1000までちゃんとできました。

 ＞リストをシートに作成し、「元の値」をそのリストへのセル参照にすることで回避できると推測します。
 お手数ですが具体的に教えていただけ無いでしょうか？

 (FA)

 ＞2007ではリスト表示がA1000までちゃんとできました。
     For i = 1 To 1000　＞＞　     For i = 1 To 10000
のようにループ回数を増やして実行すると、限界値がある程度解るかもしれません。
　
＞具体的に
例えば、セルA1:A3にデータを入力しておいて、
入力規則のリストの「元の値」のダイアログボックスへ　「=A1:A3」とすると、
セルA1:A3に入力したデータがリスト選択できる、という意味です。
したがって、引数Formula1　にリストの存在するセル範囲を表現した文字列を
渡したらどうか、ということです。
　
現在のコードを利用するなら、
＞ディクショナリの内容を一旦作業シートに吐き出す
＞吐き出したリストのシート名とセル範囲を取得する
＞引数Formula1　にリスト範囲を渡す。　
という流れになるかもしれません。
入力規則用のリストを別のシートに作成する場合には名前定義やINDIRECT関数の
使用が必要になる場合もあります。
　
[エクセルの学校　ライブラリ　(e2k) 簡易リストボックス]
https://www.excel.studio-kazu.jp/tips/0601/
　
(みやほりん)(-_∂)b

 みやほりん様

 お世話になっております。
 ご説明頂いたのですが、名前の定義などは使ったことがあり理解していますが、マクロでどのようなコードを書けば良いのか見当がつきません。

 ＞ディクショナリの内容を一旦作業シートに吐き出す
   製品リストと同じものを受注リストのあるブックの別シートにコピーするということでしょうか？

  [[20101104215614]]　『ドロップダウンリスト』（FA）
 元はこちらでご質問させて頂いて、マクロを作って頂きました。
 私自身マクロは簡単なものしか組めません。

 宜しくお願い致します。

 (FA)

 私が原因ですね。すみません。
 みやほりんさんフォローありがとうございます。
 回答方針の違いでご迷惑を・・・

　[[20101104215614]]　『ドロップダウンリスト』（FA）

 >元はこちらでご質問させて頂いて、マクロを作って頂きました。

 マクロを作って差し上げた訳ではなく、最低限動くサンプルコードから
 色々学びとって頂きたかったのですが・・・

 件数が多くてエラーになっているようですね。
 >myKey = .Keys
 でディクショナリーのキーを取りだしています。
 これを作業用セル範囲に書きだすようにします。

 >Case Is > 0: .Add Type:=xlValidateList, Formula1:=Join(myKey, ",")
 ここで、キーをリストに追加していますので
 Formula1:=Join(myKey, ",")の部分をキーを書きだした範囲のアドレスにします。

 調べて頑張ってみてください。
 （ｍｏｍｏ）

コメント返信：

[ 一覧(最新更新順) ]

[[20110128162807]] 『マクロでエラー』（FA） ページの最後に飛ぶ

[[20110128162807]]　『マクロでエラー』（FA）　ページの最後に飛ぶ