Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 11全般 : Excel 2019)
シートのコピー(連番で範囲指定あり)について
投稿日時: 25/06/21 00:33:55
投稿者: ぷーまぷーま10040311

お世話になっております。
前回、前々回と質問に対して回答いただき誠にありがとうございました。
別件でご教示いただきたくご相談となります。
 
元々以下のように「原本1」「原本1(経費)」という2つのシートをセットでコピーして、
連番でリネームするようなコードを作成しておりました。
 
しかしながら方針が変わり、原本シートを4種類作成し、
且つ、シート名の連番を以下のように範囲指定することになりました。
 
「原本1」「原本1(経費)」シート・・・No.1〜29
「原本2」「原本2(経費)」シート・・・No.30〜39
「原本3」「原本3(経費)」シート・・・No.40〜64
「原本4」「原本4(経費)」シート・・・No.65〜75
 
上記に変更した場合、コードをどのように修正すれば良いかがわからず困っております。。。
不勉強で申し訳ございませんが、ご教示いただきたく何卒よろしくお願いいたします。
 

Sub 原本1をコピーして製品管理シートと経費シートを追加()

    ' 2つのシートを「リスト」シートの前へコピーする
    Worksheets(Array("原本1", "原本1(経費)")).Copy Before:=Worksheets("リスト")
    
    ' 2つのシート名を変更する
    Dim WS As Worksheet
    Dim n As Long
    
    For Each WS In Worksheets
        If WS.Name Like "*経費*" Then
            If Not WS.Name Like "原本1(経費)" Then
                n = n + 1
            End If
        End If
    Next
    
    ' シート名の重複チェック
    Dim SheetName As String
    Dim CheckFlag As Boolean
    Dim SheetFlag As Boolean
    Dim WS2 As Integer
    
    SheetFlag = False
    For WS2 = 1 To Sheets.Count
        If Sheets(WS2).Name = n Then
            MsgBox "このシート名は既に存在しています" & vbCrLf & "シート名:" & n, vbExclamation
            SheetFlag = True
        End If
        
        If Sheets(WS2).Name = n & "(経費)" Then
            MsgBox "このシート名は既に存在しています" & vbCrLf & "シート名:" & n & "(経費)", vbExclamation
            SheetFlag = True
        End If
    Next

    ' 重複がなければシート名を設定
    If SheetFlag = False Then
        Worksheets("リスト").Previous.Previous.Name = n
        Worksheets("リスト").Previous.Name = n & "(経費)"
        CheckFlag = True
    End If
    
End Sub

回答
投稿日時: 25/06/21 12:51:52
投稿者: simple

されたいことがよく理解できないので、確認です。
 
・シートは1から順に作成していくんですか?
  29まで使い終わったら次に30以降は原本2を使っていくということですか?
  その時の「種類」というのは何を意味するんですか?
  作成した枚数によって使用する原本が変わってくるというのが、ちょっと理解しにくいです。
 
・それとも内容によって場合分けするので、
  最初に1を使用し、次には30を使用する、といったことがあるという話なんですか?
  種類を選択させるInputBoxかなにかを表示するんですか?その辺も説明が必要です。
  (ブックを4つに分けて、今のものをそのまま継続使用したほうが分かりやすくないですか?)
   
・いや一つのブックでということなら、管理シートを作り、
  4つの列にそれぞれの使用済み連番を順次記入していくような作りにすれば、
  どこまで使ったかを逐一調べなくてすむのではないですか?
  最終行を見れば使用済み番号がわかり、その次を使えばよいわけです。
 
・また、種類が分かるシート名にして、それぞれは1から始まるようにしたほうが
   分かりやすくないですか?
   特定の種類で上限に達したらどうするのですか。それで終わりにするなら、
   番号自体は空き番があるものになりますが、それでいいんですか?
   
コード以前のところをもうすこし具体的に説明して下さい。

投稿日時: 25/06/22 00:38:31
投稿者: ぷーまぷーま10040311

simple様
いつもお世話になっております。
今回もご確認いただきまして誠にありがとうございます。
また、説明が不足しており、分かりにくく申し訳ございませんでした。
以下の通り、情報を補足させていただきます。
  
【実現したいこと(補足)】
現在、弊社で加工した製品を管理するExcelファイルを改良しております。
これまでは全製品、同じ構成のシートでデータを作成しておりましたが、
製品を4つにカテゴリ分けして、各カテゴリによってシートの構成が若干異なる仕様になりました。
  
そのため、4種類の原本シートを作成しておいて、製品によって、
該当のカテゴリの原本シートをコピーして使用する運用にしたいと思っております。
  
*カテゴリ=「原本1:野菜類」「原本2:肉類」「原本3:魚類」「原本4:その他」の4種類です。
(例1)鶏のから揚げ⇒「肉類」カテゴリに分類されるため、原本2シートをコピーして使用
(例2)鮭のムニエル⇒「魚類」カテゴリに分類されるため、原本3シートをコピーして使用
  
  
また、併せてご質問いただいた内容について以下に回答させていただきます。
  

引用:
・シートは1から順に作成していくんですか?
  29まで使い終わったら次に30以降は原本2を使っていくということですか?
  その時の「種類」というのは何を意味するんですか?
  作成した枚数によって使用する原本が変わってくるというのが、ちょっと理解しにくいです。

⇒シートは昇順で作成していきたいと思っております。
(例)6/21に「鶏のから揚げ」、「鮭のムニエル」、「サバの塩焼き」を加工した場合
 ・「鶏のから揚げ」⇒シートNo.30
 ・「鮭のムニエル」⇒シートNo.40
 ・「サバの塩焼き」⇒シートNo.41
  
引用:
・それとも内容によって場合分けするので、
  最初に1を使用し、次には30を使用する、といったことがあるという話なんですか?
  種類を選択させるInputBoxかなにかを表示するんですか?その辺も説明が必要です。
  (ブックを4つに分けて、今のものをそのまま継続使用したほうが分かりやすくないですか?)

⇒説明が不足しており申し訳ございません。
上記回答で申し上げました通り、ご質問の以下のような運用になります。
引用:
「最初に1を使用し、次には30を使用する、といったことがあるという話なんですか?」

 
引用:
種類を選択させるInputBoxかなにかを表示するんですか?その辺も説明が必要です。

⇒こちらも説明が不足しており申し訳ございません。
ユーザーフォームにオプションボタンを設置してどのシートをコピーするかを選択式にする方法を考えております。
 
引用:
ブックを4つに分けて、今のものをそのまま継続使用したほうが分かりやすくないですか?

⇒おっしゃる通りだと思います。
しかしながら、こちらのExcelファイルは、毎月1ファイル作成する運用になっており、わけることができない状況です。。
  
引用:
・いや一つのブックでということなら、管理シートを作り、
  4つの列にそれぞれの使用済み連番を順次記入していくような作りにすれば、
  どこまで使ったかを逐一調べなくてすむのではないですか?
  最終行を見れば使用済み番号がわかり、その次を使えばよいわけです。

⇒おっしゃる通りですね。。。その考えが浮かばず、こちらのやり方になってしまいました・・・
ただ、毎月同じような加工商品が発生する場合があり、その場合、前月のExcelファイルから
シートコピーしてくる場合もあるようで、その場合でも使用済み連番を順次記入していく作りでも
対応は可能なのでしょうか・・・?
ご指南いただいたやり方でコードを考えてみますが、もしよろしければご教示いただけますと幸いです。。
 
引用:
・また、種類が分かるシート名にして、それぞれは1から始まるようにしたほうが
   分かりやすくないですか?
   特定の種類で上限に達したらどうするのですか。それで終わりにするなら、
   番号自体は空き番があるものになりますが、それでいいんですか?

⇒おっしゃる通りなのですが、これまでも番号自体は空き番がある状態になっておりました。
そしてこれまでのやり方を続けたい、番号がかぶっていない方が良い、
番号でカテゴリを判別したい、とのことでこのような仕様で作成したいと考えております。。
  
運用面について、色々と疑問があるかと存じますが、
今回このような修正を行いたいと思っております。
  
分かりずらい部分があり申し訳ございませんが、ご確認のほど何卒よろしくお願いいたします。

回答
投稿日時: 25/06/22 02:49:25
投稿者: hatena
投稿者のウェブサイトに移動

引用:
且つ、シート名の連番を以下のように範囲指定することになりました。
  
「原本1」「原本1(経費)」シート・・・No.1〜29
「原本2」「原本2(経費)」シート・・・No.30〜39
「原本3」「原本3(経費)」シート・・・No.40〜64
「原本4」「原本4(経費)」シート・・・No.65〜75

 
指定範囲内の連番の空番号を取得して、コピー後にその空番号でリネームするという考え方でいいでしょう。
 
引用:
ユーザーフォームにオプションボタンを設置してどのシートをコピーするかを選択式にする方法を考えております。

 
情報不足なので下記のようだと仮定します。
 
ユーザーフォームに下記のコントロールが配置されている
OptionButton1, OptionButton2, OptionButton3, OptionButton4
CommandButton1
 
オプションボタンを選択してコマンドボタンクリックで原本シートのコピー実行
 
ユーザーフォームのモジュールに下記のコードを記述します。
 
Option Explicit

Private Sub CommandButton1_Click()
    If Me.OptionButton1.Value = True Then
        原本をコピーして製品管理シートと経費シートを追加 1
    ElseIf Me.OptionButton2.Value = True Then
        原本をコピーして製品管理シートと経費シートを追加 2
    ElseIf Me.OptionButton3.Value = True Then
        原本をコピーして製品管理シートと経費シートを追加 3
    ElseIf Me.OptionButton4.Value = True Then
        原本をコピーして製品管理シートと経費シートを追加 4
    End If
End Sub

Sub 原本をコピーして製品管理シートと経費シートを追加(CategoryNum As Long)
   
    ' 2つのシート名の未使用番号を取得する
    Dim StartNum As Long, EndNum  As Long
    Select Case CategoryNum
    Case 1
        StartNum = 1: EndNum = 29
    Case 2
        StartNum = 30: EndNum = 39
    Case 3
        StartNum = 40: EndNum = 64
    Case 4
        StartNum = 65: EndNum = 75
    End Select
    
    Dim i As Long, UnusedNum As Long
    On Error Resume Next
    For i = StartNum To EndNum
        If Worksheets(i & "") Is Nothing And Worksheets(i & "(経費)") Is Nothing Then
            UnusedNum = i
            Exit For
        End If
    Next
    On Error GoTo 0
       
    If UnusedNum = 0 Then
        MsgBox "シート名の空番号は存在していません"
        Exit Sub
    End If
    
    ' 2つのシートを「リスト」シートの前へコピーする
    Worksheets(Array("原本" & CategoryNum, "原本" & CategoryNum & "(経費)")).Copy Before:=Worksheets("リスト")
    
    ' シート名を設定
    Worksheets("リスト").Previous.Previous.Name = UnusedNum
    Worksheets("リスト").Previous.Name = UnusedNum & "(経費)"
    
End Sub

回答
投稿日時: 25/06/23 23:20:15
投稿者: simple

質問者さん、当方からの質問への回答・説明ありがとうございました。
個人的にどうなのかなと思わない箇所がないでもありませんが、
使うのは私ではありませんので、これ以上は慎みます。
 
いつもながらhatenaさんから冴えわたった回答が寄せられています。
なぜコメントがないのでしょう。

投稿日時: 25/06/24 17:02:03
投稿者: ぷーまぷーま10040311

hatena様
 
お世話になります。
せっかく回答いただいたにも関わらず、返信が遅くなり、
誠に申し訳ございませんでした。
 
いただいたコードにて実施いたしましたところ、
まさにやりたかったことを実現することができました。
 
こちらの情報が不足しておりましたのに、
回答していただけたこと、本当に感謝いたします。
 
コードを読み解きながら一つ一つ勉強して
理解して行きたいと思います。
 
この度は本当にありがとうございました。

投稿日時: 25/06/24 17:07:15
投稿者: ぷーまぷーま10040311

simple様
 
お世話になります。
hatena様への返信遅延の件、大変申し訳ございませんでした。
諸事情につき、返信が遅くなってしまいました。。
 
せっかく迅速に解決策を提案いただいたにも関わらず、
質問者が返答しないという大変無礼な態度となりましたこと、
心より反省しております。
今後、このようなことのないよう留意いたします。
 
この度も誠にお世話になりありがとうございました。