[[20221227111631]]　『マクロが、動かなくなった』（こまった）　ページの最後に飛ぶ

『マクロが、動かなくなった』（こまった）

下記のような、マクロコードを作成しました。

今年の１月に、作成し当初は動作していたのですが１年ぶりに
起動してみたら動作しなくなっていました。

エクセルのバージョンは、2016から365へ変更になりました。

そこらへんも動かなくなった原因なのでしょうか？

今日中に、修正したいです。

Sub 連続シート作成()

    Dim 対象月 As Range
    Dim 対象月分 As Range
    Dim i, r
    r = 2
    For i = 2 To 13

        For Each 対象月 In Worksheets("対象リスト").Range("A2:A13")
            Worksheets("運転日誌(7173)様式").Copy after:=Worksheets(Worksheets.Count)
            ActiveSheet.Name = Worksheets("対象リスト").Range("A" & i).Value
            ActiveSheet.Range("A3") = Worksheets("対象リスト").Range("C" & r).Value
            'ActiveSheet.Range("K2") = Worksheets("対象リスト").Range("C" & r).Value
        i = i + 1
        r = r + 1
        Next
    Next

    r = 2
    For i = 14 To 25
　　・・・続く

＜使用 Excel：Microsoft365、使用 OS：Windows10 ＞

＞動かなくなった

どういう意味？　エラー発生？
そのへんちゃんと書かな。

（いそげ） 2022/12/27(火) 11:24:08

＞起動してみたら動作しなくなっていました。
マクロそのものが実行されないのか、それともエラーが出るのかどちらなんでしょうか。
エラーの場合はエラー名を添付するとより良い回答があるかと思います。
＞・・・続く
全て提示された方がいいですよ。
（bjzq） 2022/12/27(火) 11:27:22

動いていた方が疑問なんだが、意味の無いループとか。
（疑問） 2022/12/27(火) 11:46:13

ほんまやね。
For i = 2 To 13 ・・・ Next の中に i = i + 1 とか謎のコード入ってるし。
こまるところ、満載の予感。

（いそげ） 2022/12/27(火) 12:02:45

＞マクロが、動かなくなった
まずは、【ステップ実行】して原因を探ってみましょう。
ステップ実行も出来ないようなら、マクロの実行自体が禁止されていないか、確認してください。

また、全体が提示されていないのでよくわかりませんが、既にコメントがあるように無駄ループになっているとおもいます。
整理すると↓のようになるとおもいますので、落ち着いてコードを分析してみてはどうでしょうか？

    Sub 連続シート作成()
        Dim 対象月 As Range

        For Each 対象月 In Worksheets("対象リスト").Range("A2:A13")
            Worksheets("運転日誌(7173)様式").Copy after:=Worksheets(Worksheets.Count)
            With Worksheets(Worksheets.Count)
                .Name = 対象月.Value
                .Range("A3").Value = 対象月.Offset(, 2).Value
            End With
        Next 対象月
    End Sub

（もこな２） 2022/12/27(火) 12:12:28

ああ、もともとまともに動いていない物を動いてましたと
作り直させる新手かどうか知らないがそういう方法か。
（疑問） 2022/12/27(火) 13:04:44

＞（こまった）
＞今日中に、修正したいです。

と言う割にその後音沙汰なし。失礼極まりなし。
もしや新手の愉快犯か。

（行きずり） 2022/12/27(火) 13:17:32

Sub 連続シート作成()

    Dim 対象月 As Range
    Dim 対象月分 As Range
    Dim i, r
    r = 2
    For i = 2 To 13

        For Each 対象月 In Worksheets("対象リスト").Range("A2:A13")
            Worksheets("運転日誌(1111)様式").Copy after:=Worksheets(Worksheets.Count)
            ActiveSheet.Name = Worksheets("対象リスト").Range("A" & i).Value
            ActiveSheet.Range("A3") = Worksheets("対象リスト").Range("C" & r).Value
            'ActiveSheet.Range("K2") = Worksheets("対象リスト").Range("C" & r).Value
        i = i + 1
        r = r + 1
        Next
    Next

    r = 2
    For i = 14 To 25
        For Each 対象月 In Worksheets("対象リスト").Range("A14:A25")
            Worksheets("運転日誌 (2222)様式").Copy after:=Worksheets(Worksheets.Count)
            ActiveSheet.Name = Worksheets("対象リスト").Range("A" & i).Value
            ActiveSheet.Range("A3") = Worksheets("対象リスト").Range("C" & r).Value
            'ActiveSheet.Range("K2") = Worksheets("対象リスト").Range("C" & r).Value
        i = i + 1
        r = r + 1
        Next
    Next

    r = 2
    For i = 26 To 37
        For Each 対象月 In Worksheets("対象リスト").Range("A26:A37")
            Worksheets("運転日誌 (3333)様式").Copy after:=Worksheets(Worksheets.Count)
            ActiveSheet.Name = Worksheets("対象リスト").Range("A" & i).Value
            ActiveSheet.Range("A3") = Worksheets("対象リスト").Range("C" & r).Value
            'ActiveSheet.Range("K2") = Worksheets("対象リスト").Range("C" & r).Value
        i = i + 1
        r = r + 1
        Next
    Next
End Sub

全コードは、このようになります。

エラー内容は、　「パスがみつかりません。\VBD840.tmp」

です。
（こまった） 2022/12/27(火) 13:36:37

■１

 For i = 2 To 13
     For Each 対象月 In Worksheets("対象リスト").Range("A2:A13")
         i = i + 1
     Next 対象月
 Next i

よく見ると↑のようになっているから、内側のループが回り切った段階で「i」が14になってしまい、外側のループは１回しか動作しないですよね。

よって、本当はこうしたかったのではありませんか？

    Sub 研究用()
        Dim i As Long

        For i = 2 To 13
            Worksheets("運転日誌(7173)様式").Copy after:=Worksheets(Worksheets.Count)
            With Worksheets(Worksheets.Count)
                .Name = Worksheets("対象リスト").Range("A" & i).Value
                .Range("A3").Value = Worksheets("対象リスト").Range("C" & i).Value
            End With
        Next       
    End Sub

いずれにせよ、For ～ Nextステートメントの中でカウンタ変数を勝手に加算したらおかしなことになると思いますので再考されてみてはどうでしょうか？

■２
＞エラー内容は、　「パスがみつかりません。\VBD840.tmp」
どの箇所で発生しているのでしょうか？
ざっと見た感じ、そういったエラーが発生するようには見えませんが・・・・

 (あと、コメントアウトしてる行がじゃまくさいです。いらないなら削除されては？）

■３
＞全コードは、このようになります。

 For i = 2 To 13
    For Each 対象月 In Worksheets("対象リスト").Range("A2:A13")

 For i = 14 To 25
    For Each 対象月 In Worksheets("対象リスト").Range("A14:A25")

 For i = 26 To 37
    For Each 対象月 In Worksheets("対象リスト").Range("A26:A37")

整理すると↑のようになります。「■１」と被りますが、二重ループにする必要性がないと思いますので、再考されてみてはどうですか？

（もこな２） 2022/12/27(火) 14:13:15

本当にそのエラーが出ているのなら、
提示したコード以外のプロシージャで
エラーが出ているとしか思えない。
（腰痛ぇもん） 2022/12/27(火) 16:43:34

一応コードを整理してみましたが、上記のエラーは関係ないように思います

Sub 連続シート作成()

    Dim i
    For i = 0 To 35
        Select Case i \ 12
            Case 0
                Worksheets("運転日誌(1111)様式").Copy after:=Worksheets(Worksheets.count)
            Case 1
                Worksheets("運転日誌(2222)様式").Copy after:=Worksheets(Worksheets.count)
            Case 2
                Worksheets("運転日誌(3333)様式").Copy after:=Worksheets(Worksheets.count)
        End Select
        Worksheets(Worksheets.count).Name = Worksheets("対象リスト").Range("A2").Offset(i).Value
        Worksheets(Worksheets.count).Range("A3") = Worksheets("対象リスト").Range("C2").Offset(i Mod 12).Value
    Next
End Sub
（OSVLfxp7KN） 2022/12/27(火) 16:59:30

Option Explicit

Sub test()

    Dim c As Range
    Dim s As String

    For Each c In Worksheets("対象リスト").Range("A2:A37")
        Select Case c.Row
            Case Is > 25: s = "運転日誌 (3333)様式"
            Case Is > 13: s = "運転日誌 (2222)様式"
            Case Else: s = "運転日誌 (1111)様式"
        End Select

         Worksheets(s).Copy after:=Worksheets(Worksheets.Count)
         With Worksheets(Worksheets.Count)
            .Name = c.Value
            .Range("A3").Value = c.Offset(, 2).Value
        End With
    Next
End Sub

こんな感じかなぁ。。。。

 >エラー内容は、　「パスがみつかりません。\VBD840.tmp」

VBEのツールバーから、
ツール　→　オプション　→　全般　→　エラートラップ
は、「エラー発生時に中断」になってますか？
なってなかったら、変えてみたら、どこでどんなエラーが出るか説明してみてください。

（まっつわん） 2022/12/27(火) 17:51:09

残念ながらトピ主の反応がなくなってしまいましたが、私も１案。

    Sub さんぷる()
        Dim i As Long

        For i = 0 To 35 Step 1
            Select Case i
                Case 0 To 11: Worksheets("運転日誌(1111)様式").Copy after:=Worksheets(Worksheets.Count)
                Case 12 To 23: Worksheets("運転日誌(2222)様式").Copy after:=Worksheets(Worksheets.Count)
                Case 24 To 35: Worksheets("運転日誌(3333)様式").Copy after:=Worksheets(Worksheets.Count)
            End Select

            With Worksheets(Worksheets.Count)
                .Name = Worksheets("対象リスト").Range("A" & i + 2).Value
                .Range("A3") = Worksheets("対象リスト").Range("C" & (i Mod 12) + 2).Value
            End With
        Next
    End Sub

 ほぼ、OSVLfxp7KNさん案の焼き増しですね

（もこな２） 2022/12/27(火) 21:03:09

コメント返信：

[ 一覧(最新更新順) ]

[[20221227111631]] 『マクロが、動かなくなった』（こまった） ページの最後に飛ぶ

[[20221227111631]]　『マクロが、動かなくなった』（こまった）　ページの最後に飛ぶ