[[20210126163315]]　『コードの書き方について』（しのみや）　ページの最後に飛ぶ

『コードの書き方について』（しのみや）

 漠然とした質問ですみません。
 動いているけれど、こんなのでよいのかな？もっとよくならないかな？と
 思って質問させて頂きます。

 現在のシートをコピーし

 　シート名"A-1"がなければ、シート名"A-1"とする

 　シート名"A-1"があれば、シート名"A-2"とする

 　シート名"A-2"があれば、シート名"A-3"とする

 　シート名"A-3"があれば、シート名"A-1"を削除し、
 　シート名"A-2"を"A-1"にし、シート名"A-3"を"A-2"にしてから
 　シート名"A-3"とする

 以下のような記述を作ったのですが、
 IFを使って、そのままだらだらと書いてしまっているように思います。
 よい書き方はありますか？

 Sub SubTest()
    Dim Worksheet     As Worksheet
    Dim SheetName As String

    Set Worksheet = ActiveSheet

    If ExistsWorksheet("A-1") = False Then
        SheetName = "A-1"
    Else
        If ExistsWorksheet("A-2") = False Then
            SheetName = "A-2"
        Else
            If ExistsWorksheet("A-3") = False Then
                SheetName = "A-3"
            Else
                Application.DisplayAlerts = False
                Sheets("A-1").Delete
                Application.DisplayAlerts = True
                Sheets("A-2").name = "A-1"
                Sheets("A-3").name = "A-2"

                SheetName = "A-3"
            End If
        End If
    End If

    Worksheet.Copy after:=Worksheet
    ActiveSheet.name = SheetName
 End Sub

 Public Function ExistsWorksheet(ByVal name As String)
    Dim ws As Worksheet
    For Each ws In Sheets
        If ws.name = name Then
            ExistsWorksheet = True ' 存在する
            Exit Function
        End If
    Next
    ExistsWorksheet = False ' 存在しない
 End Function

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

ちょっと仕様を理解していないところがありますが、
私は↓のように書きます。

気になった点はFunctionの返り値の型ですが、
true/falseなので、Boolean型にすべきです。

 Sub Sample()
     Dim dic As Object
     Dim ws As Worksheet
     Dim target As String
     Set dic = CreateObject("Scripting.Dictionary")

     For Each ws In Worksheets
         dic.Add ws.Name, ws.Name
     Next ws

     Select Case True
     Case Not dic.Exists("A-1")
         target = "A-1"
     Case Not dic.Exists("A-2")
         target = "A-2"
     Case Not dic.Exists("A-3")
         target = "A-3"
     Case dic.Exists("A-3")
         Application.DisplayAlerts = False
         Worksheet("A-1").Delete
         Application.DisplayAlerts = True
         Worksheet("A-2").Name = "A-1"
         Worksheet("A-3").Name = "A-2"
         target = "A-3"
     End Select

     With ActiveSheet
         .Copy after:=Worksheets(Worksheets.Count)
         .Name = target
     End With
     Set dic = Nothing
 End Sub
（tkit） 2021/01/26(火) 17:16

コード中のあちこちに
A-1とかA-3とか出てくるのに違和感を覚えられたのかなぁ。。。。

少し捻ってコレクションオブジェクトを使ってみてはいかがでしょうか？

Sub test()

    Dim myCol As New Collection
    Dim ws As Worksheet
    Dim v As Variant
    Dim vv As Variant
    Dim i As Long

    '規定のシートをコレクションに取得
    vv = Array("A-1", "A-2", "A-3")
    For Each v In vv
        'シートの存在確認
        Set ws = Nothing
        On Error Resume Next
        Set ws = Worksheets(v)
        On Error GoTo 0
        '追加
        If Not ws Is Nothing Then myCol.Add ws
    Next
    'すでに3個あれば、1番目を削除
    If myCol.Count = 3 Then
        myCol.Remove 1
        Application.DisplayAlerts = False
        myCol(1).Delete
        Application.DisplayAlerts = True
    End If

    '新しいシートをコレクションに追加
    Set ws = ActiveSheet
    ws.Copy after:=ws
    myCol.Add ws.Next

    'シート名の付け直し
    For Each v In myCol
        v.Name = vv(i)
        i = i + 1
    Next
End Sub
（まっつわん） 2021/01/26(火) 18:56

 私も出品します。

    Sub sample()

      ActiveSheet.Copy After:=ActiveSheet

      i = 1
      newSheetName = Format(i, "A-0")
      On Error GoTo Err_SheetName
         ActiveSheet.Name = newSheetName
      On Error GoTo 0

      Application.DisplayAlerts = False
      If ActiveSheet.Name = "A-4" Then
         Worksheets("A-1").Delete
         Worksheets("A-2").Name = "A-1"
         Worksheets("A-3").Name = "A-2"
         Worksheets("A-4").Name = "A-3"
      End If
      Application.DisplayAlerts = True
      Exit Sub

    Err_SheetName:
      i = i + 1
      newSheetName = Format(i, "A-0")
      Resume
    End Sub
（´・ω・`） 2021/01/26(火) 19:38

 tkitさん　ありがとうございます
 >true/falseなので、Boolean型にすべきです。
 直します。

 CreateObjectは、ファイル操作のときに出てくる…程度でしか覚えていなかったのですが、
 こんな風にも使えるのですね。

 まっつわんさん　ありがとうございます
 こちらの書き方ですと、シートがA-10までと増えた場合でも対応しやすいですね。

 私のやり方がまずかったら申し訳ないのですが、
 'すでに3個あれば、1番目を削除のときの
 myCol(1).Deleteが、A-2を削除しにいってしまっており
 'シート名の付け直しのときに「オブジェクトが必要です」となりました。

 以下にするとうまく動きました。
    If myCol.Count = 3 Then
        Application.DisplayAlerts = False
        myCol(1).Delete
        Application.DisplayAlerts = True
        myCol.Remove 1
    End If

 （´・ω・`）さん　ありがとうございます
 Formatは書式設定でしか使ってなかったのですが、
 このように使えるのですね。

 勉強になります。ありがとうございました。
（しのみや） 2021/01/27(水) 10:38

 >Formatは書式設定でしか使ってなかったのですが、
 見てほしかったのはそこじゃないんですけどね。

 前のコードはちょっと加齢臭がひどいので、少し変えました

    Sub sample()

      ActiveSheet.Copy After:=ActiveSheet

      i = 0
      On Error Resume Next
         Do
            i = i + 1
            newSheetName = Format(i, "A-0")
            Err.Clear
            ActiveSheet.Name = newSheetName
         Loop Until Err = 0
      On Error GoTo 0

      Application.DisplayAlerts = False
      If ActiveSheet.Name = "A-4" Then
         Worksheets("A-1").Delete
         Worksheets("A-2").Name = "A-1"
         Worksheets("A-3").Name = "A-2"
         Worksheets("A-4").Name = "A-3"
      End If

      Application.DisplayAlerts = True

    End Sub
（´・ω・`） 2021/01/27(水) 10:52

 （´・ω・`）さん　ありがとうございます
 頂く記述は理解できるようになってきたのですが、
 それに対し何か言語化できるような能力がなくすみません…

 理解できました。助かります。
（しのみや） 2021/01/27(水) 14:36

コメント返信：

[ 一覧(最新更新順) ]

[[20210126163315]] 『コードの書き方について』（しのみや） ページの最後に飛ぶ

[[20210126163315]]　『コードの書き方について』（しのみや）　ページの最後に飛ぶ