教えて!gooにおける不適切な投稿への対応について

いつもお世話になっております。
下記のコードですでに同じシートがあれば、
終了としたいのですが、

シートが追加されてしまいます。

Sub Macro()
On Error Resume Next
For i = 2 To 5
Sheets.Add After:=Sheets(Sheets.Count)
If ActiveSheet.Name <> Format(Sheets("MAIN").Cells(i, 1), "m月d日") Then
ActiveSheet.Name = Format(Sheets("MAIN").Cells(i, 1), "m月d日")
Else
Exit Sub
End If
Next
End Sub

質問者からの補足コメント

  • HAPPY

    めぐみん様 やっばりすごいです
    ありがとうございました。

    No.6の回答に寄せられた補足コメントです。 補足日時:2021/04/09 19:28
gooドクター

A 回答 (6件)

書き直し。


あと変数の宣言はしましょうね。
基本です。

Sub megu()
Dim myDic As Object
Dim ws As Worksheet, new_ws As Worksheet
Dim r As Range, st As String

Set myDic = CreateObject("Scripting.Dictionary")

For Each ws In Worksheets
myDic.Add ws.Name, ""
Next

With Worksheets("MAIN")
For Each r In .Range("A2", .Cells(Rows.Count, "A").End(xlUp))
st = Format(r.Value, "m月d日")

If Not myDic.Exists(st) Then
Set new_ws = Worksheets.Add(After:=Worksheets(Worksheets.Count))
new_ws.Name = st
myDic.Add new_ws.Name, ""
Set new_ws = Nothing
End If

Next
End With

Set myDic = Nothing

End Sub
この回答への補足あり
    • good
    • 0
この回答へのお礼

ご返事遅れて申し訳ありません
ありがとうございました。

お礼日時:2021/04/09 19:23

No.1&2です。



あ~寝ぼけて名前リストのセル値変化を見落としてました・・・すいません忘れて下さい。
    • good
    • 0

おはようございます


既に解決されているご質問も拝見いたしましたが、
らしからぬ迷宮に入っているようですが、シートの挿入や名前設定って
結構お決まりのメソッドがあります。
On Error Resume Next だとエラーが出る時は名前を変える時なので
既にExcelが自動設定した名前のシートが出来てしまいます。
なのでSheets.Addの前で名前が使えるかなどを調べ、処理を飛ばす必要があります。ご質問の場合は終了ですかね。

ただ、サンプルは名前に出来る文字列しかセルに無いようですが、空白セルや/が入っている文字列などが途中にあるとエラーになります。
結構お決まりなので、分かり難いかも知れませんがコードを示します。

Function については、忘れてしまいましたが、どこかで拾ったものです。

Sub Macro1()
Dim r As Range
Dim AtvSheet As Worksheet
Set AtvSheet = ActiveSheet
For Each r In AtvSheet.Range("A2:A5")
If PermitName(r.Text) = False _
Or Not SheetExists(r.Text) Is Nothing Then GoTo nexSh
Sheets.Add(After:=Sheets(Sheets.Count)).Name = r.Text
nexSh:
Next r
AtvSheet.Select
End Sub
'同名チェック
Function SheetExists(ByVal argName As String, _
Optional ByVal wb As Workbook = Nothing) As Object
Dim sht As Object
If wb Is Nothing Then Set wb = ThisWorkbook
For Each sht In wb.Sheets
If StrConv(LCase(sht.Name), vbNarrow) = StrConv(LCase(argName), vbNarrow) Then
Set SheetExists = sht
Exit Function
End If
Next
Set SheetExists = Nothing
End Function
'文字チェック
Function PermitName(ByVal argName As String) As Boolean
PermitName = False
If argName = "" Then Exit Function
If Len(argName) > 31 Then Exit Function
If argName = "履歴" Then Exit Function
If Left(argName, 1) = "'" Then Exit Function
Dim NgChar As Variant
NgChar = Array(vbNullChar, _
":", "\", "/", "?", "*", "[", "]", _
":", "\", "/", "?", "*", "[", "]", "\")
Dim i As Long
For i = 0 To UBound(NgChar)
If InStr(argName, NgChar(i)) > 0 Then
Exit Function
End If
Next
PermitName = True
End Function

ループは、後で改修し易いのでFor Each r In AtvSheet.Range("A2:A5")と
しました。個人的感覚。
Sheets("MAIN")は、実行時のシートをSet AtvSheet = ActiveSheet としていますので明示されるのが良いと思います。(ActiveSheet部分を変更してください)
ほぼ対応できると思います。ステップ実行で確認してみてください。
>同じシートがあれば、終了
処理は飛ばしているだけなのでデータ範囲の最後まで処理されます。
    • good
    • 0
この回答へのお礼

ご返事遅れて申し訳ありません
ありがとうございました。
NgChar = Array(vbNullChar, _
":", "\", "/", "?", "*", "[", "]", _
":", "\", "/", "?", "*", "[", "]", "\")これは初めてみました。

お礼日時:2021/04/09 19:24

セルの値をシート名2 -いつもお世話になっております。

セルA2からA31- Excel(エクセル) | 教えて!goo
https://oshiete.goo.ne.jp/qa/12299779.html

ここから加工を続けている感じでしょうか。

作成したマクロだと
①シートを追加する
 (追加されるシートは「Sheet?」という名前)

②シート名の変更処理
 追加したシートの名前がMAINシートのA列に用意したものと…
  (1)違うなら名前を変更
  (2)同じなら終了

という流れなです。
追加されるシートは「Sheet?」なので、MAINシートに用意したシート名リストと異なるのは当然です。
なので②-(2)の処理は行われることはありません。

また、追加したシートの名前を変更する際に、既存のシートの名前と重複する場合、②-(1)でエラーになりますが、
On Error Resume Next
で、エラーが出ても処理続行にしてるので、Forループが最後まで実行されます。


なので、

最初に、
①同名のシートの有無を確認
②同名のシートが…
 無ければシートを追加して名前変更
 あれば終了
という流れにします。

Sub Macro()
'  On Error Resume Next
  For i = 2 To 5
    CHK = 0
    For j = 1 To Sheets.Count
      If Sheets(j).Name = Format(Sheets("MAIN").Cells(i, 1), "m月d日") Then
        CHK = 1
        Exit For
      End If
    Next
    If CHK = 0 Then
      Sheets.Add After:=Sheets(Sheets.Count)
      ActiveSheet.Name = Format(Sheets("MAIN").Cells(i, 1), "m月d日")
    Else
      Exit For
    End If
  Next
End Sub
    • good
    • 0
この回答へのお礼

ありがとうございました。

お礼日時:2021/04/09 19:25

No.1です。



>If Worksheets(i).Name = Format(Sheets("MAIN").Cells(i, 1), "m月d日") Then ch = False



If Worksheets(i).Name = Format(Sheets("MAIN").Cells(i, 1), "m月d日") Then ch = False : Exit For

があとが無駄にならず良いかも。
    • good
    • 0

検証してませんが。


まずは同じ名前があるかどうかを調べましょう。

あったらその後は無視。
なかったら作成する。

Sub Macro()
Dim i As Integer, ch As Boolean

ch = True

For i = 2 To 5 ' Worksheets.Count ?
If Worksheets(i).Name = Format(Sheets("MAIN").Cells(i, 1), "m月d日") Then ch = False
Next

If ch Then
Worksheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = Format(Sheets("MAIN").Cells(i, 1), "m月d日")
End If

End Sub
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

gooドクター

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング