Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

1029 / 76735

←次へ　｜　前へ→


	【81364】Re:シート名が重複していたら連番を振る

OK - 20/6/23(火) 20:59 -


	引用なし

	パスワード

サンプルです。

Sub test()
Dim wb As Workbook
Dim basewsmei As String
Dim wsmei As String
Dim flg As Boolean
Dim newwsmei As String
Dim cnt As Integer
　Set wb = ActiveWorkbook
　 basewsmei = "Sheet"
　 If wschek(wb, basewsmei) = False Then
　　　newwsmei = basewsmei
　 Else
　　cnt = 0
　　Do Until flg = True
　　 cnt = cnt + 1
　　 newwsmei = basewsmei & "(" & Format(cnt, "0") & ")"
　　 If wschek(wb, newwsmei) = True Then
　　　　flg = False
　　 Else
　　　　flg = True
　　 End If
　　Loop
　End If
　wb.Worksheets.Add after:=wb.Worksheets(wb.Worksheets.Count)
　ActiveSheet.Name = newwsmei
　Set wb = Nothing
End Sub

Function wschek(ByVal wb As Workbook, wsmei As String) As Boolean
Dim myrng As Range
　Err.Clear
　On Error Resume Next
　Set myrng = wb.Worksheets(wsmei).Range("A1")
　If Err.Number <> 0 Then
　　 wschek = False '存在しない＝新規シート名として使える
　Else
　　 wschek = True '存在する＝新規シート名として使えない
　End If
　Set myrng = Nothing
　On Error GoTo 0
End Function

1 hits

▼

【81362】シート名が重複していたら連番を振る VBAビギナー 20/6/23(火) 11:06