Excel (VBA) |
![]() ![]() |
(Windows 11全般 : Excel 2019)
シートのコピー(連番で範囲指定あり)について
投稿日時: 25/06/21 00:33:55
投稿者: ぷーまぷーま10040311
|
---|---|
お世話になっております。
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
|
---|---|
されたいことがよく理解できないので、確認です。
|
![]() |
投稿日時: 25/06/22 00:38:31
投稿者: ぷーまぷーま10040311
|
---|---|
simple様
引用: ⇒シートは昇順で作成していきたいと思っております。 (例)6/21に「鶏のから揚げ」、「鮭のムニエル」、「サバの塩焼き」を加工した場合 ・「鶏のから揚げ」⇒シートNo.30 ・「鮭のムニエル」⇒シートNo.40 ・「サバの塩焼き」⇒シートNo.41 引用: ⇒説明が不足しており申し訳ございません。 上記回答で申し上げました通り、ご質問の以下のような運用になります。 引用: 引用: ⇒こちらも説明が不足しており申し訳ございません。 ユーザーフォームにオプションボタンを設置してどのシートをコピーするかを選択式にする方法を考えております。 引用: ⇒おっしゃる通りだと思います。 しかしながら、こちらのExcelファイルは、毎月1ファイル作成する運用になっており、わけることができない状況です。。 引用: ⇒おっしゃる通りですね。。。その考えが浮かばず、こちらのやり方になってしまいました・・・ ただ、毎月同じような加工商品が発生する場合があり、その場合、前月のExcelファイルから シートコピーしてくる場合もあるようで、その場合でも使用済み連番を順次記入していく作りでも 対応は可能なのでしょうか・・・? ご指南いただいたやり方でコードを考えてみますが、もしよろしければご教示いただけますと幸いです。。 引用: ⇒おっしゃる通りなのですが、これまでも番号自体は空き番がある状態になっておりました。 そしてこれまでのやり方を続けたい、番号がかぶっていない方が良い、 番号でカテゴリを判別したい、とのことでこのような仕様で作成したいと考えております。。 運用面について、色々と疑問があるかと存じますが、 今回このような修正を行いたいと思っております。 分かりずらい部分があり申し訳ございませんが、ご確認のほど何卒よろしくお願いいたします。 |
![]() |
投稿日時: 25/06/22 02:49:25
投稿者: hatena
|
---|---|
引用: 指定範囲内の連番の空番号を取得して、コピー後にその空番号でリネームするという考え方でいいでしょう。 引用: 情報不足なので下記のようだと仮定します。 ユーザーフォームに下記のコントロールが配置されている 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
|
---|---|
質問者さん、当方からの質問への回答・説明ありがとうございました。
|
![]() |
投稿日時: 25/06/24 17:02:03
投稿者: ぷーまぷーま10040311
|
---|---|
hatena様
|
![]() |
投稿日時: 25/06/24 17:07:15
投稿者: ぷーまぷーま10040311
|
---|---|
simple様
|