マンガでよめる痔のこと・薬のこと

超VBA初心者です
書式シートを追加した際に、シート名の変更をします
そのシート名変更の月(month)を12までにして、1月からループしたいです
シート名が2020.12までいったら、2021.1・・・となるように

どのような号令文にしたらよいか教えてください
↓この号令文の意味もわかっておりませんが今の状態です

Sub シート追加()
'
' シート追加 Macro
'
Dim i As Long
i = 1
Sheets("書式").Copy after:=Worksheets(Worksheets.Count - 1)
On Error Resume Next
Do
Err.Clear

ActiveSheet.Name = Year(Date) & "." & CStr(i)
i = i + 1
Loop Until Err.Number = 0
On Error GoTo 0

ActiveSheet.DrawingObjects.Delete
End Sub

A 回答 (2件)

こんばんは、


ご質問の解釈が難しく、すでに回答が出ておりますが、解釈を変えて回答します。

疑問に思った事
>そのシート名変更の月(month)を12までにして、1月からループしたいです  :1月から12月まで一度に作成したい
>シート名が2020.12までいったら、2021.1・・・となるように
否定している1~12なのになぜ年またぎの例を挙げている?

>↓この号令文の意味もわかっておりませんが今の状態です

簡単にご説明をすると、
書式と名前の付いたシートをコピーしてシートタグで表示されている右から2番目に新たに作成し
新しく出来たシート名を2020.重複しない連番 i に変更して、(2020は年、すでにある名前の場合はエラーになるのでエラーにならなくなるまで繰り返す。結果重複しない番号が付きます)
シート上のDrawingObject(全ての図など?)を削除して終了

もしかしたら、一度に12枚のシートを作成しなくても良いのかもと思いました。

下記は、一枚だけ作成される構文です。コピーが出来るシート位置は、最後(一番右)に変えました。
名前は、重複を考え希望と少し違うかもしれません。同じ名前がある場合、実行した年.月+αの名前になります。
基本的に示されている号令文に沿ったものです。(わかっていないにしても、少なからず内容を知っていると思いますので)

Sub シート追加()
' シート追加 Macro
Dim i As Long
  i = 0
  Sheets("書式").Copy after:=Worksheets(Worksheets.Count)  '書式名シートをコピーして一番右シートに作る
  On Error Resume Next  'エラーがあっても次の行に進む
  Do        'ループ
   Err.Clear    'エラー発生をリセット
   If i > 0 Then   ' i が1以上なら下の方法で名前を付ける
    ActiveSheet.Name = Year(Date) & "." & Month(Date) & "(" & CStr(i) & ")"
   Else      ' 条件に当てはまらなければ、(i が0なら下の方法で名前を付ける)
    ActiveSheet.Name = Year(Date) & "." & Month(Date)
   End If
   i = i + 1    ' i に1を足す
  Loop Until Err.Number = 0  'エラーでなくなるまで繰り返す ループ
  ActiveSheet.DrawingObjects.Delete  '新しく出来たシート上の図などを削除する (古いオブジェクトなので注意
  Range("A1").Select
End Sub

的外れと思いますが、参考まで
    • good
    • 1
この回答へのお礼

解決しました

こんばんは
わかり辛い質問で悩ませて申し訳ございません
ご解釈の通りです!!1シートずつ作りたかったです
わたくしの意図を考慮したうえで作ってくださりありがとうございます
5月下旬にに6月のシートを作ることもございますので、Month(Date)は使用しておりませんでした
そこが悔しくも少し悩みどころですがやはり質問してよかったです!
自分に合わせて1つ1つに説明文を付けてくださり感謝いたします
また自分の号令文を基に作ってくださったこともあり、とてもわかり易く勉強になりました

お礼日時:2020/06/06 12:14

こんにちは



若干内容を変えていますが、こんな感じでしょうか?
※ シートの追加作成位置をシートの最終位置に追加してゆきます。
※ 終了がはっきりしませんので、nでシート数を指定するようにしています。
※ 同様に最初のシート名を日付で指定するようにしています。
   nDate = DateValue("2020/1/1")の部分

エラー処理は特に行っていません。
(すでに同名のシートが存在する場合などはエラーになります)

Sub Sample_11685381()
Dim sht As Worksheet, nDate As Date, i As Integer
Const n = 12

Set sht = Worksheets("書式")
nDate = DateValue("2020/1/1")

For i = 1 To n
 sht.Copy after:=Worksheets(Worksheets.Count)
 Set sht = ActiveSheet
 sht.Name = Year(nDate) & "." & Month(nDate)
 nDate = DateSerial(Year(nDate), Month(nDate) + 1, 1)
Next i
End Sub
    • good
    • 1
この回答へのお礼

ありがとう

こんにちは
早速のご回答ありがとうございます
解釈もつけてくださってありがとうございます
やってみました!12月までが一度に作成でき、シート名もこの通りでございます!
ただ毎月1シートずつ作っていくというのが自分の中で1つのキーになっておりました

考え方もとても勉強になりました
わかり辛い質問にも関わらず回答してくださりありがとうございました
参考にいたします!

お礼日時:2020/06/06 11:20

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング