[[20070223130852]]　『VBA実行時エラー’457’への対応方法を！』（まとな）　ページの最後に飛ぶ

『VBA実行時エラー’457’への対応方法を！』（まとな）

 いつもお助けいただきっぱなしで恥ずかしいのですが、お願いします。
 シート１の情報（リスト）を生かして（そのまま、パクリだと叱られそうですが）
シート３七曜年間暦を作成するプログラムをVBAで作成しています。
 今までにこの学校の方々から御指南いただいたものを利用しながらあと一歩のとこ
ろまできました。
 しかし、次のマクロを実行しようとしたところ、次のようなエラーが出てしまうの
で、困っています。
 「dic.Add .Cells(i, 7).Value, .Cells(i, 4).Value」のところで
 「実行時エラー’457’」「このキーは既にこのコレクションの要素に割り当てられ
ています。」
 というエラー表示が出て止まってしまいます。
 この問題への対処方法をお教えいただけないでしょうか。
 年間ダイアリー完成まであと一歩のところまできたので、何とかこの障害を乗り越
えたいのです。
 どなたかお願いします。
 よいアドバイスをお願いします。
 ちょっと、長くなりますが、関係各マクロを載せます。
   [Excel2003][WindowsXP]

 Sub Syukujitu()
 '******************************
 '   祝日処理
 '******************************
    Dim dic As Object
    Dim hani As Range
    Dim i As Long
    Dim myr As Range
    Dim lastrow As Long

    Set dic = CreateObject("Scripting.Dictionary")
    Set hani = Worksheets("Sheet3").Range("C4:C56,J4:J56,Q4:Q56,X4:X56,AE4:AE56,AL4:AL56,AS4:AS56") 
     With Worksheets("Sheet1")
       lastrow = .Cells(Rows.Count, 19).End(xlUp).Row
       For i = 4 To lastrow
         dic.Add .Cells(i, 20).Value, .Cells(i, 19).Value
       Next i
     End With

     For Each myr In hani
       If dic(myr.Value) <> "" Then
           myr.Offset(, 1).Value = dic(myr.Value)
           'myr.Resize(, 2).Font.ColorIndex = 3
           With myr.Resize(, 7)
             .Font.ColorIndex = 3
             .Interior.ColorIndex = 15
             .Interior.Pattern = xlSolid
          End With
       End If
     Next myr

 End Sub

 Sub hurikyugyo()
 '**************************
 '   振替休業日処理
 '**************************
    Dim dic As Object
    Dim hani As Range
    Dim i As Long
    Dim myr As Range
    Dim lastrow As Long

    Set dic = CreateObject("Scripting.Dictionary")
    Set hani = Worksheets("Sheet3").Range("C4:C56,J4:J56,Q4:Q56,X4:X56,AE4:AE56,AL4:AL56,AS4:AS56")

      With Worksheets("Sheet1")
       lastrow = .Cells(Rows.Count, 4).End(xlUp).Row
       For i = 26 To lastrow
         dic.Add .Cells(i, 7).Value, .Cells(i, 4).Value　　　　　　　　　←ここで
       Next i
     End With

     For Each myr In hani
       If dic(myr.Value) <> "" Then
           myr.Offset(, 1).Value = dic(myr.Value)
           With myr.Resize(, 7)
             .Font.ColorIndex = 3
             .Interior.ColorIndex = 15
             .Interior.Pattern = xlSolid
          End With
       End If
     Next myr

 End Sub

 Sub hurijyugyo()
 '**********************
 '   振替勤務日処理
 '**********************
    Dim dic As Object
    Dim hani As Range
    Dim i As Long
    Dim myr As Range
    Dim lastrow As Long

    Set dic = CreateObject("Scripting.Dictionary")
    Set hani = Worksheets("Sheet3").Range("C4:C56,J4:J56,Q4:Q56,X4:X56,AE4:AE56,AL4:AL56,AS4:AS56")

     With Worksheets("Sheet1")
      lastrow = .Cells(Rows.Count, 4).End(xlUp).Row
      For i = 19 To lastrow
        dic.Add .Cells(i, 7).Value, .Cells(i, 4).Value　　　　　　　　　　←ここで
      Next i
    End With

    For Each myr In hani
      If dic(myr.Value) <> "" Then
          myr.Offset(, 1).Value = dic2(myr.Value)
          'myr.Resize(, 2).Font.ColorIndex = 3
          With myr.Resize(, 7)
            .Interior.ColorIndex = 2
            .Interior.Pattern = xlSolid
         End With
      End If
    Next myr

 End Sub

 Sheet1のG列に重複するデータはありませんか？
 (ROUGE)

 ROUGEさん、早速ありがとうございます。
 ご指摘のSheet１のG列ということは、７列ということですよね。
 ７列には日付（平成19年2月23日という形で）が入っていますが、
重複データは見つかりません。
 プログラム記述の問題ではなく、参照データの重複問題というこ
とでしょうか？
 しかし、D列（４列）には、重複コメント（文字列）があります。
これが原因でしょうか？
 なお、振替休業日関連情報リストと、振替勤務日関連情報リストは
1行の空き行を作って、上下に並べています。
 項目は、A列：番号、B列：月、C列：日、D列：振替理由、
G列：日付と同じです。
 G列は、B列とC列の情報をもとに関数で年月日を導き出しています。
 （まとな）

 G列に重複がないとなると、Addメソッドは正常に動くはずなのですが。。。
 ここでの箇所を
 dic(Cells(i, 7).Value) = .Cells(i, 4).Value
 にしたらどうなりますか？
 Bookをコピーして試してください。
 (ROUGE)

 ROUGEさん、すみません。アドバイスのように
 「dic.Add .Cells(i, 7).Value, .Cells(i, 4).Value」部分を
 「dic(Cells(i, 7).Value) = .Cells(i, 4).Value」に直して実行させて
みました。
 エラー表示は出ることなく最後までいきましたが、シート３には何の変化
も現れません。
 目的の動作をしていないようです。
(まとな)

 > dic(Cells(i, 7).Value) = .Cells(i, 4).Value
 dic(.Cells(i, 7).Value) = .Cells(i, 4).Value
     ~ の間違いでした。orz
 (ROUGE)

 >myr.Offset(, 1).Value = dic2(myr.Value)
 で、なぜエラーがでんのやろ？
 それとＧ列が振替日っちゅう事なら空白行があるはずですわなぁ。それがdic.Addに
 ひっかかっとんとちゃいまっか？   
　イチャモン屋（弥太郎）

 ROUGEさん、ありがとうございました。
 振替休業日の方はどうしたわけか、以前のままでも正常に
動作するようになりました。
 振替勤務日の方は
　指摘部分を「dic(.Cells(i, 7).Value) = .Cells(i, 4).Value」
にしたところ、エラーなく動きました。
 ところが、１行空きに用意した振替休業日リスト範囲まで反映す
るような動きとなってしまいました。
      lastrow = .Cells(Rows.Count, 4).End(xlUp).Row
      For i = 19 To lastrow
 の部分で最終行情報が受け取れずにエクセル本来の最終行まで参
照するようになっているのではないかと思うのですが？
 対処として「lastrow = .Cells(Rows.Count, 4).End(xlUp).Row」
をコメント行処理して、「For i = 19 To lastrow」を
「For i = 19 To 22」←振替勤務日関連リストの最終行番号
 とすればよいのだろうと予想がつくのですが、
 折角の記述を生かす方法はないのでしょうか。
 イチャモン屋（弥太郎）さんのご指摘（空白行がしっかりあるんです）
もありますし！！
 お教えくだされば幸いです。
 (まとな)

 取り急ぎ
 大変失礼しました。「Dic2」と訂正していたところを、「Dic」のままのもので確認をしていました。
 振替勤務日の方を「dic(.Cells(i, 7).Value) = .Cells(i, 4).Value」と訂正し、「Dic」を「Dic2」としたところ、正常に動作しました。
 ROUGEさん、イチャモン屋（弥太郎）さん、申し訳ありませんでした。
 助かりました。
 (まとな)

コメント返信：

[ 一覧(最新更新順) ]

[[20070223130852]] 『VBA実行時エラー’457’への対応方法を！』（まとな） ページの最後に飛ぶ

[[20070223130852]]　『VBA実行時エラー’457’への対応方法を！』（まとな）　ページの最後に飛ぶ