いつもお世話になっております。
下記のコードですでに同じシートがあれば、
終了としたいのですが、
シートが追加されてしまいます。
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
No.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
No.4
- 回答日時:
おはようございます
既に解決されているご質問も拝見いたしましたが、
らしからぬ迷宮に入っているようですが、シートの挿入や名前設定って
結構お決まりのメソッドがあります。
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部分を変更してください)
ほぼ対応できると思います。ステップ実行で確認してみてください。
>同じシートがあれば、終了
処理は飛ばしているだけなのでデータ範囲の最後まで処理されます。
ご返事遅れて申し訳ありません
ありがとうございました。
NgChar = Array(vbNullChar, _
":", "\", "/", "?", "*", "[", "]", _
":", "\", "/", "?", "*", "[", "]", "\")これは初めてみました。
No.3
- 回答日時:
セルの値をシート名2 -いつもお世話になっております。
セルA2からA31- Excel(エクセル) | 教えて!goohttps://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
No.2
- 回答日時:
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
があとが無駄にならず良いかも。
No.1
- 回答日時:
検証してませんが。
まずは同じ名前があるかどうかを調べましょう。
あったらその後は無視。
なかったら作成する。
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
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・人生のプチ美学を教えてください!!
- ・10秒目をつむったら…
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・【大喜利】【投稿~9/18】 おとぎ話『桃太郎』の知られざるエピソード
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルVBAで次の様にデーター...
-
excelのマクロで該当処理できな...
-
VBAでオブジェクト変数にsetし...
-
エクセルのシート名変更で重複...
-
VBA オートフィルター繰り返し
-
特定の文字を含むシートだけマ...
-
VBA ユーザーフォーム上のチェ...
-
excelで新規作成されるシート名...
-
エクセルのマクロでアクティブ...
-
別のシートを参照して計算する方法
-
エクセルで通し番号を入れてチ...
-
EXCEL VBA:シートの右クリック...
-
VBAで同じシート名のコピー時は...
-
ListViewの画面の更新
-
Excel VBA 複数行を数の分だけ...
-
VBA 入力月で該当シートを選択...
-
VBA 検索して一致したセル...
-
同じ作業を複数のシートに実行...
-
VBAの「This Workbook」について
-
『実行時エラー'1001': 'Range...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
特定の文字を含むシートだけマ...
-
excelのマクロで該当処理できな...
-
【ExcelVBA】全シートのセルの...
-
ユーザーフォームに入力したデ...
-
別のシートから値を取得するとき
-
ブック名、シート名を他のモジ...
-
実行時エラー'1004': WorkSheet...
-
Excelマクロのエラーを解決した...
-
XL:BeforeDoubleClickが動かない
-
シートが保護されている状態で...
-
エクセルのシート名変更で重複...
-
実行時エラー1004「Select メソ...
-
VBAで同じシート名のコピー時は...
-
エクセルで通し番号を入れてチ...
-
同じ作業を複数のシートに実行...
-
Excel VBA リンク先をシート...
-
ExcelのVBAのマクロで他のシー...
-
Vba UserformからExcelシートの...
-
【Excel VBA】Worksheets().Act...
-
VBA 存在しないシートを選...
おすすめ情報
めぐみん様 やっばりすごいです
ありがとうございました。