Excel VBA質問箱 IV

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

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


238 / 13644 ツリー ←次へ | 前へ→

【81362】シート名が重複していたら連番を振る VBAビギナー 20/6/23(火) 11:06 質問[未読]
【81363】Re:シート名が重複していたら連番を振る OK 20/6/23(火) 20:33 発言[未読]
【81364】Re:シート名が重複していたら連番を振る OK 20/6/23(火) 20:59 発言[未読]
【81365】Re:シート名が重複していたら連番を振る OK 20/6/23(火) 22:02 発言[未読]
【81367】Re:シート名が重複していたら連番を振る OK 20/6/24(水) 9:29 発言[未読]
【81368】Re:シート名が重複していたら連番を振る VBAビギナー 20/6/29(月) 10:21 お礼[未読]

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

引用なし
パスワード
   お世話になります。
VBA初心者です。

CSVファイルから申込書へ転記し、
申込書のシート名にセルの値を追記しています。

ActiveSheet.Name = "txt_" & WS.Range("A1")

"A1"を追記した時に既に同一名のシートが存在した場合はエラーになります。
シート名重複のエラーを出さずにsheet(1)、sheet(2)といった感じで
出力する仕組みを入れたいです。

どなたかご教授お願いいたします。

【81363】Re:シート名が重複していたら連番を振る
発言  OK  - 20/6/23(火) 20:33 -

引用なし
パスワード
   とくていの名前のシートは存在するか否かを判定する方法です。

ht tp://officetanaka.net/excel/vba/tips/tips10.htm

エラー処理を使った方法です。

Sub test()
Dim wsmei As String
Dim myrng As Range
 wsmei = "Sheet4"
 Err.Clear
 On Error Resume Next
 Set myrng = Worksheets(wsmei).Range("A1")
 If Err.Number <> 0 Then
   MsgBox wsmei & vbCrLf & "は存在しない"
 Else
   MsgBox wsmei & vbCrLf & "は存在する"
 End If
 Set myrng = Nothing
 On Error GoTo 0
End Sub

これらを改変して指定の名前のシートが存在しなくなるまでループ処理
するようにすればいいと思います。

【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

【81365】Re:シート名が重複していたら連番を振る
発言  OK  - 20/6/23(火) 22:02 -

引用なし
パスワード
   ↑は新規シートを追加していますが、既存シートの名前変更も
シートの有無チェックに関しては考え方は同じです。

【81367】Re:シート名が重複していたら連番を振る
発言  OK  - 20/6/24(水) 9:29 -

引用なし
パスワード
   ↑のコードの↓を削除したらアクティブシートのシート名を変更するコードになります。

wb.Worksheets.Add after:=wb.Worksheets(wb.Worksheets.Count)

シート名を変更する対象がアクティブシートでないのなら、↓のシートオブジェクトの
部分を適宜変更してください。

ActiveSheet.Name = newwsmei

【81368】Re:シート名が重複していたら連番を振る
お礼  VBAビギナー  - 20/6/29(月) 10:21 -

引用なし
パスワード
   ご教授ありがとうございます。
お礼が遅くなり申し訳ありません。

いただいたコードを元に作成してみます!
本当にありがとうございます。

238 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free