[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『コードの書き方について』(しのみや)
漠然とした質問ですみません。 動いているけれど、こんなのでよいのかな?もっとよくならないかな?と 思って質問させて頂きます。
現在のシートをコピーし
シート名"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
少し捻ってコレクションオブジェクトを使ってみてはいかがでしょうか?
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
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.