• 締切済み

■助けてください。■エクセルのマクロで困っています。

エクセルで、シートを一つ削除するマクロを教えてください。 本当に困っています。 マクロをご存知の方、ずぶの素人の私にご教示何卒よろしくお願いします。 文末にマクロを記述いたしますが、そちらは、 指定した日付以降にエクセルのファイルを開くと シートがすべて削除されて、「有効期限切れ」という シートだけが出てくるというものです。 現在、これを応用して、すべてのシートを 削除するのではなく、ひとつのシートだけ削除したいのです。 例えば「SheetA」、「SheetB」、「SheetC」、「有効期限切れ」という ４つのシートがあったとして、 指定した期日が来たら、「SheetC」だけを削除したいのです。 なお、エクセルファイルを開く際に、マクロを無効にされてしまうと 期日が来てもSheetCが削除されずに 残ってしまっては困るのです。 そこで、マクロを有効にしないと SheetCが現れないようにしたいのです。 （以下のマクロではそのようになっています） 一つだけシートを削除するマクロをやり方をご存知の方、マクロのご教示のほど 何卒よろしくお願い致します。 なお、小生、マクロはずぶの素人でして、 マクロの文面を頂いてコピー貼り付けするぐらいしか 能がありません。 つきましては、以下の文面を モディファイしてご教示頂けませんでしょうか。 よろしくお願いいたします。 Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) endsheetname = "有効期限切れ" If (Sheets.Count = 1) And (Sheets(1).Name = endsheetname) Then Exit Sub If Sheets("SheetA ").Visible Then Sheets("SheetC ").Visible = xlVeryHidden End Sub Private Sub Workbook_Open() endsheetname = "有効期限切れ" If Date >= "3008/09/29" Then Application.DisplayAlerts = False If Sheets.Count = 1 Then If Sheets(1).Name <> endsheetname Then Sheets.Add(After:=ActiveSheet).Name = endsheetname End If Else On Error Resume Next Sheets(endsheetname).Delete On Error GoTo 0 Sheets.Add(After:=ActiveSheet).Name = endsheetname End If sheetnumber = Sheets.Count For i = 1 To sheetnumber For j = 1 To 2 If Sheets.Count = 1 Then Exit For If Sheets(j).Name = " SheetC " Then If Not Sheets("SheetC ").Visible Then Sheets("SheetC ").Visible = True If Sheets(j).Name <> endsheetname Then Sheets(Sheets(j).Name).Delete: Exit For Next Next Range("b" & 3).Value = "ご利用ありがとうございました。" ActiveWorkbook.Save Application.DisplayAlerts = True End If If (Sheets.Count = 1) And (Sheets(1).Name = endsheetname) Then Exit Sub If Not Sheets(" SheetC ").Visible Then Sheets(" SheetC ").Visible = True End Sub

みんなの回答

  • hige_082
  • ベストアンサー率50% (379/747)
回答No.1

＞マクロの文面を頂いてコピー貼り付けするぐらいしか能がありません。 回答は付かないと思います 理由は 「禁止事項」の「丸投げ・依頼」項目をよく読んでください 上記の理由から、直接的な回答は出来ません アレンジはご自身で 分からなければ勉強するか、分かる人へ聞いてください 'このマクロはThisWorkbookへ記述してください Private Sub Workbook_BeforeClose(Cancel As Boolean) If Worksheets("sheet3").Visible <> 2 Then Worksheets("sheet3").Visible = 2 End If End Sub Private Sub Workbook_Open() If Date <= "2008/09/29" Then Worksheets("sheet3").Visible = -1 End If End Sub 新規作成したブックで試してみてください 色々生意気なことを書きましたが、悪気は無いことをご理解ください

  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. オフィス系ソフト

関連するQ&A

  • ■シートを一つ削除するマクロを教えてください。

    前に、http://oshiete1.goo.ne.jp/qa4352149.html で質問させて頂きました。 その節は、お世話になりありがとうございました。 今回は、前回と似たようなものですが、 少々条件を変更したマクロを作成したいので ご協力のほど、何卒よろしくお願い致します。 文末にマクロを記述いたしますが、そちらは、 指定した日付以降にエクセルのファイルを開くと シートがすべて削除されて、「有効期限切れ」という シートだけが出てくるというものです。 今度は例えば「SheetA」、「SheetB」、「SheetC」という 3つのシートがあったとして、 指定した期日が来たら、「SheetC」だけを削除したいのです。 条件があり、「SheetC」は、マクロを有効にしないと使用できないようにしたいのです。 やり方をご存知の方、ご教示のほど 何卒よろしくお願い致します。 Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) endsheetname = "有効期限切れ" If (Sheets.Count = 1) And (Sheets(1).Name = endsheetname) Then Exit Sub If Sheets("SheetA ").Visible Then Sheets("SheetC ").Visible = xlVeryHidden End Sub Private Sub Workbook_Open() endsheetname = "有効期限切れ" If Date >= "3008/09/29" Then Application.DisplayAlerts = False If Sheets.Count = 1 Then If Sheets(1).Name <> endsheetname Then Sheets.Add(After:=ActiveSheet).Name = endsheetname End If Else On Error Resume Next Sheets(endsheetname).Delete On Error GoTo 0 Sheets.Add(After:=ActiveSheet).Name = endsheetname End If sheetnumber = Sheets.Count For i = 1 To sheetnumber For j = 1 To 2 If Sheets.Count = 1 Then Exit For If Sheets(j).Name = " SheetC " Then If Not Sheets("SheetC ").Visible Then Sheets("SheetC ").Visible = True If Sheets(j).Name <> endsheetname Then Sheets(Sheets(j).Name).Delete: Exit For Next Next Range("b" & 3).Value = "ご利用ありがとうございました。" ActiveWorkbook.Save Application.DisplayAlerts = True End If If (Sheets.Count = 1) And (Sheets(1).Name = endsheetname) Then Exit Sub If Not Sheets(" SheetC ").Visible Then Sheets(" SheetC ").Visible = True End Sub

  • エクセルのマクロについて教えていただきたいのですが・・・

    見積書を作成しているんですが、1枚目のシート（見積書）に明細が書ききれなかった時に、マクロを実行すると、『明細書』と言う名前のシートが(1)～(5)枚目まで追加され、各シートの小計を1枚目のシートに書き出す・・・と言うマクロを作りたいのですが、うまくいかずに困っています＞＜ 追加されるシートの元となる『見積もりマスター』と言うシートがあって、そのシート内でそれぞれのシートの小計は取れるのですが・・・ 下記のマクロの中に何か追加すればうまくいく方法はありますか？？ （明細書は追加する時もあれば追加しない時もあってその都度、使う人が、最大5枚まで何枚追加するかを決めるそうです。） Sub Macro1() Dim cnt As Integer Dim wkNum As Double Dim ws As Worksheet 　For Each ws In Worksheets 　　If Left(ws.Name, 4) = "明細書(" Then 　　　If IsNumeric(Mid(ws.Name, 5, 1)) Then 　　　　wkNum = Val(Mid(ws.Name, 5, 1)) 　　　　If cnt < wkNum Then 　　　　　cnt = wkNum 　　　　End If 　　　End If 　　End If 　Next ws 　If cnt >= 5 Then 　　MsgBox ("明細書シートが既に５枚以上あるため追加できません") 　　Exit Sub 　Else 　　Sheets("明細マスター").Copy after:=Sheets(Worksheets.Count) 　　ActiveSheet.Name = "明細書(" & cnt + 1 & ")" 　End If End Sub マクロ自体をあまり理解できてなくて、会社の人や、ここで教えていただいて進めているので、出来ればそのままコピーして使用できるようにしていただけるとありがたいです。 よろしくお願いします。

  • エクセル　マクロ　エラー

    Sub 保存() Dim MySheetName As Variant MySheetName = InputBox("シート名を入力してください") If MySheetName = "" Then Exit Sub Sheets("1").Copy After:=Sheets(Worksheets.Count) ActiveSheet.Name = MySheetName Sheets("原本").Range("A1:K73").Copy Sheets("1原本").Range("A1") End Sub シートにグラフを乗せたらエラーが出たのですが 解除できないでしょうか？

  • Excelマクロ　途中まで作成したマクロの修正をお願いします

    Excelマクロ　途中まで作成した下記のマクロの修正をお願いできませんでしょうか。 【マクロ-途中　説明】 全シートのアクティブセルを「A1」にして、最後に左端のシートにして終了。→ファイル保存時、見栄えを良くするために使用 【修正点】 アクティブセル「A1」に移動を変更。 B列の一番下から「END+↑」でとんだ位置で止まる。 複数のシート（20以上）を同じ作業（ブック内の全シート） 同じく最後に一番左端のシートでをアクティブシートにして終了 ※A列は空白行のため、必ず埋まっているB列を基準にしたい 上記の【修正点】を下記の【マクロ-途中】に反映したい。 ↓ 【マクロ-途中】 Sub 全シートをHOMEポジションに() Dim ws As Variant For Each ws In Worksheets If Sheets(ws.Name).Visible = True Then Sheets(ws.Name).Select Range("A1").Select End If Next Sheets(1).Select End Sub

  • エクセルVBAで一番左の可視シート名を取得

    エクセルVBAで一番左側にあるシート名を取得する場合、通常は Sub test01() 　　MsgBox Sheets(1).Name End Sub で簡単にできますが、このSheets(1)が非表示になっている場合でもその名前が取得されるため、見た目での一番左側にあるシート名ではなくなってしまいます。 もちろん、非表示になっているシートを除外して Sub test02() 　　Dim n As Integer 　　For n = 1 To Sheets.Count 　　　　If Sheets(n).Visible Then 　　　　　　MsgBox Sheets(n).Name 　　　　　　Exit For 　　　　End If 　　Next End Sub とすれば取得できるのはわかりますが、こんなまだるっこい方法以外に簡単に一番左の可視シート名を取得する方法はないでしょうか？ （＾∇＾）？ ご教示くださいませ。

  • エクセルのシートをマクロで並び替えたいです。

    以前に、Q&Aがあったので、下記の物を入れてみましたが、シート名に会社名を入れている為、前(株)○○となると、全て(株)で集まってしまいます。 エクセル2003を使っています。 Sub SortSheets() Dim intLoopA As Integer Dim intLoopB As Integer For intLoopA = 1 To Sheets.Count For intLoopB = 1 To Sheets.Count - 1 If Sheets(intLoopB).Name > Sheets(intLoopB + 1).Name Then Sheets(intLoopB).Move after:=Sheets(intLoopB + 1) End If Next intLoopB Next intLoopA End Sub ご理解いただけますでしょうか？ お分かりになられる方宜しくお願い致します。

  • エクセル/マクロ　Exit Subが実行されない

    エクセルマクロの質問です。エクセルのヴァージョンは2000です。 あるシートをコピーして新シートに任意の名前を付けるマクロを作っています。ユーザーフォームの中に一つのテキストボックス（新シートの名前入力用）と二つのコマンドボタンを設置し一つは実行ボタン、もう一つはキャンセルボタンとしました。 QNo.6367227でエラー処理に関する質問をさせていただきましたが、こちらは見事に解決していただきました。 今回の質問はExit Subに関する質問です。 If構文で、条件文１が真であればシートをコピーして名前を変更、フォームを閉じるという処理を目指しています。 If　条件　Then　～　処理　Exit Sub という形を作って試してみたのですが、処理後にExit Subが実行されません。Exit Subの前にメッセージボックスを挿むとメッセージは表示されましたが、やはりExit Subにはたどり着けませんでした。 すごく初歩的な事で恥ずかしいのですが、Exit Subが実行されない理由と解決法をご教示いただけると助かります。よろしくお願いします。 Private Sub CommandButton1_Click() Dim NewSheetName As String NewSheetName = TextBox1.Value On Error Resume Next Sheets("Summary").Name = NewSheetName If Err.Number = 0 Then Sheets(NewSheetName).Copy before:=Sheets(NewSheetName) ActiveSheet.Name = "Summary" MsgBox ("Tasｋ Completed!") ExitSub Else MsgBox "Invalid name!" End If On Error GoTo 0 End Sub

  • エクセルマクロについて助言下さい。

    エクセルマクロについて助言下さい。 ★やりたい事 シート名を指定しアクティブにする BOOOKに複数のセルがあり、シート名は日付（1・2など） 但し、必ず連続ではなく1~31までのシートが存在します。 現在のマクロ↓ シート名を取得し関数で指定のシートが存在するか確認しています。 作業シートのC1セルが0で指定シートなし　0でないで指定シートあり（処理開始）としてます。 作業2のI3セルに日付データがあります。 Sub 抽出() 'シート名を取得する Sheets("作業").Select Dim i As Integer Dim mySheetCnt As Integer Dim mySheetNam As String 　　 mySheetCnt = ThisWorkbook.Sheets.Count For i = 1 To mySheetCnt mySheetNam = Sheets(i).Name Sheets("作業").Cells(i, 1) = mySheetNam Next i　　 Range("A1").Select If ActiveCell.Value = "" Then 'A1が空白の場合の処理 MsgBox "指定の日付のシートが存在しません" Exit Sub End If Sheets("作業").Select Range("C1").Select If ActiveCell.Value = 0 Then 'C1が0の場合の処理 MsgBox "指定の日付のシートが存在しません" Exit Sub End If Sheets("作業2").Select Range("I3").Select Sheets(ActiveCell.alue).Select End Sub このコードだと3と指定すると左から３枚目にあるシートが選択されます。 ３枚目ではなくシート名が　３　を選択したいのです。。 分かりにく説明で申し訳ありませんが、教えてください。

  • Excelマクロにてシートの削除を行いたいです。

    初めて投稿させて頂きます。 質問内容 　Excelのマクロを使用して指定シート以外のシートの削除を行いたいです。 前条件 　外部CSVファイルを取込み、データによってシートを追加して振り分けています。 　再度マクロを実行した場合特定のシートを残し（フォーマット等）、他のシートを削除してからデータの振り分けを実施する予定です。 やってみた事 　下記の様に書いて実施してみたのですがエラーとなってしまいます。 Sub Clear() 　　Application.DisplayAlerts = False 　　For I = 1 To Worksheets.Count 　　　　If (Worksheets(I).Name <> "sheet") Then 　　　　　　Sheets(Worksheets(I).Name).Select 　　　　　　ActiveWindow.SelectedSheets.Delete 　　　　End If 　　Next I 　　Application.DisplayAlerts = True End Sub 上記の書き方だと1シート毎削除なので、選択したシートを一括で削除出来るとうれしいです。 どなたかご存知の方お願いします。

  • 強制的にマクロを有効にするVBA

    エクセル2010を使っている者です。 マクロの入ったファイルを開くときに、強制的にマクロを有効にするようなVBAは どのように組めば良いか、ご教授願います。 ネットで調べてみると、以下のものが見つかりました。 http://www.saka-en.com/office/vba-open-the-macro-enabled-forcibly/ 1 Option Explicit 2 3'** 4 ' ワークブックオープン 5'** 6 Private Sub Workbook_Open() 7 ThisWorkbook.Unprotect Password:="password" 8 On Error Resume Next 9 If ThisWorkbook.Sheets("編集用").Visible <> True Then ThisWorkbook.Sheets("編集用").Visible = True 10 If ThisWorkbook.Sheets("ダミー").Visible <> False Then ThisWorkbook.Sheets("ダミー").Visible = False 11 ThisWorkbook.Protect Password:="password" 12 'ThisWorkbook.RunAutoMacros Which:=xlAutoOpen 13 On Error GoTo 0 14 Exit Sub 15 End Sub 16 17 '** 18' ワークブックを閉じる前 19 '** 20 Private Sub Workbook_BeforeClose(Cancel As Boolean) 21 Dim Answer As Long 22' 保存されているかチェック 23 If ThisWorkbook.Saved = False Then 24 Answer = MsgBox("Do you want to save the changes to the '" & ThisWorkbook.Name & "' ?", vbExclamation + vbOKCancel, "Microsoft Excel") 25 Select Case Answer 26 Case vbCancel 27 Cancel = True 28 Exit Sub 29 End Select 30 End If 31 ThisWorkbook.Unprotect Password:="password" 32 On Error Resume Next 33 If ThisWorkbook.Sheets("ダミー").Visible <> True Then ThisWorkbook.Sheets("ダミー").Visible = True 34 If ThisWorkbook.Sheets("編集用").Visible <> False Then ThisWorkbook.Sheets("編集用").Visible = False 35 ThisWorkbook.Protect Password:="password" 36 ThisWorkbook.Save 37 End Sub しかし、このコードだと、編集するシートが1枚であれば良いのですが、何枚もある場合や、随時、シートを追加していくようなファイルの場合は修正が必要だと思います。 どのように修正すれば良いのでしょうか。 もしくは、例えば、マクロが有効になっていない場合は、ファイルは開けるものの、注意喚起のメッセージボックスを有効にするまで表示させるような設定にすることは可能でしょうか。 ご教授いただけると幸いです。 よろしくお願いいたします。

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する