Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
9792 / 13657 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【25428】削除指定の仕方 rough 05/5/31(火) 19:40 質問[未読]
【25431】Re:削除指定の仕方 Kein 05/5/31(火) 20:46 回答[未読]
【25432】Re:削除指定の仕方 Kein 05/5/31(火) 20:50 発言[未読]
【25435】Re:削除指定の仕方 rough 05/5/31(火) 22:11 質問[未読]
【25439】Re:削除指定の仕方 Kein 05/5/31(火) 23:27 発言[未読]
【25441】Re:削除指定の仕方 rough 05/6/1(水) 0:35 質問[未読]
【25442】Re:削除指定の仕方 rough 05/6/1(水) 0:57 質問[未読]
【25479】Re:削除指定の仕方 rough 05/6/1(水) 20:10 質問[未読]
【25481】Re:削除指定の仕方 つん 05/6/1(水) 21:14 回答[未読]
【25482】Re:削除指定の仕方 ichinose 05/6/1(水) 22:10 発言[未読]
【25531】Re:削除指定の仕方 rough 05/6/3(金) 13:56 お礼[未読]
【25459】Re:削除指定の仕方 つん 05/6/1(水) 14:16 回答[未読]
【25460】あ、それから つん 05/6/1(水) 14:19 回答[未読]
【25428】削除指定の仕方
質問  rough  - 05/5/31(火) 19:40 -
引用なし
パスワード
   １つのブックに複数のシートがあるとして、
先頭シート(仮に名前を"H")と最終シート(仮に名前を"E")は固定で、その間にシートが挿入（複数枚で枚数は一定ではない）されていくとする。
ある時、先頭(H)と最後(E)のシートは残して、間のシートを全て削除する方法は？
更に削除命令をした際あらためて削除していいかの問い合わせをしてこないことが望ましいのですが・・・・。
【25431】Re:削除指定の仕方
回答  Kein  - 05/5/31(火) 20:46 -
引用なし
パスワード
   Sub SH_Del()
　 Dim SAry() As String
　 Dim i As Integer, Ans As Integer
　
　 Ans = MsgBox("本当にシートを削除しますか", 36)
　 If Ans = 7 Then Exit Sub
　 For i = 2 To Worksheets.Count - 1
　　　ReDim Preserve SAry(i - 1)
　　　SAry(i - 1) = Worksheets(i).Name
　 Next i
　 With Application
　　　.ScreenUpdating = False
　　　.DisplayAlerts = False
　 End With
　 Sheets(SAry).Delete: Erase SAry
　 With Application
　　　.ScreenUpdating = True
　　　.DisplayAlerts = True
　 End With
End Sub

で、どうかな ?
【25432】Re:削除指定の仕方
発言  Kein  - 05/5/31(火) 20:50 -
引用なし
パスワード
   >削除命令をした際あらためて削除していいかの問い合わせをしてこないことが望ましい
の、意味がちょっと分かりかねますが、冒頭に

If Worksheets.Count < 3 Then Exit Sub

と追加しておけば、既に削除してしまった場合は、二重に処理を行わなくなりますが。
【25435】Re:削除指定の仕方
質問  rough  - 05/5/31(火) 22:11 -
引用なし
パスワード
   Keinさん回答ありがとうございました。
早速実行してみましたが、
Sheets(SAry).Delete:Erase SAryがデバックしてしまいます。
また、追加の件ですが、削除を実行すると、Excelの方から「データがあるのに本当に削除していいのですか？」と聞いてくるのをなくしたいのです。複数の人が使用し中には超初心者がいるので混乱しないためにそうしたいのですが。
【25439】Re:削除指定の仕方
発言  Kein  - 05/5/31(火) 23:27 -
引用なし
パスワード
   そのコードはテスト済みです。よって原因は分かりません。
>「データがあるのに本当に削除していいのですか？」と聞いてくるのをなくしたい
.DisplayAlerts = False が、Excelのメッセージを止める働きをしています。
【25441】Re:削除指定の仕方
質問  rough  - 05/6/1(水) 0:35 -
引用なし
パスワード
   「インデックスが有効範囲にありません」とメッセージが出るのですが？
【25442】Re:削除指定の仕方
質問  rough  - 05/6/1(水) 0:57 -
引用なし
パスワード
   ▼rough さん：
>「インデックスが有効範囲にありません」とメッセージが出るのですが？
内容を今一度確認します。
先頭に集計シート(S)があり２番目にダミーの空シート(H)、３番目にもダミーの空シート(E)があります。日毎に新データの書き込まれたシートが３番目のシート前に挿入されて行きます。便宜上新たなシート名を順番に1.2.3・・・・とつけるとすると、シートの構成は何日か後に、＜集計シート(S)(H)(1)(2)(3)・・・・(E)＞となります。そこで、一定後に(H)と(E)の間のシートを削除することで、集計シート(S)を更新してまた新たなデータを(H)と(E)の間に挿入していく様にしたいのです。宜しくお願いいたします。
【25459】Re:削除指定の仕方
回答  つん E-MAIL  - 05/6/1(水) 14:16 -
引用なし
パスワード
   こんにちは＾＾

▼rough さん：
>「インデックスが有効範囲にありません」とメッセージが出るのですが？

Keinさんのコードの

　 For i = 2 To Worksheets.Count - 1
　　　ReDim Preserve SAry(i - 1)
　　　SAry(i - 1) = Worksheets(i).Name
　 Next i

太字んとこを

ReDim Preserve SAry(1 To i - 1)

にしてみたらどうでしょうか？
【25460】あ、それから
回答  つん E-MAIL  - 05/6/1(水) 14:19 -
引用なし
パスワード
   keinさんのコードやったら、一番目と最後のシートを残して削除！
なので、調整しはる必要があるかと思います。
名前で判断して、削除するほうがいいかも〜〜〜？
【25479】Re:削除指定の仕方
質問  rough  - 05/6/1(水) 20:10 -
引用なし
パスワード
   Keinさん、つん、さんありがとうございます。
うまくいきました。
ところで最後につんさんが言ってた通り、シート名を指定して、(H)と(E)の間のシートを全て削除といったVBAにしたいのですが、その場合どうしたら言いでしょうか？最初からの説明が悪く面倒かけて申し訳ありません。
【25481】Re:削除指定の仕方
回答  つん E-MAIL  - 05/6/1(水) 21:14 -
引用なし
パスワード
   こんばんは

▼rough さん：
>Keinさん、つん、さんありがとうございます。
>うまくいきました。
>ところで最後につんさんが言ってた通り、シート名を指定して、(H)と(E)の間のシートを全て削除といったVBAにしたいのですが、その場合どうしたら言いでしょうか？最初からの説明が悪く面倒かけて申し訳ありません。

削除するシート名を配列に入れるところで

　 For i = 1 To Worksheets.Count
　　　　If Worksheets(i).Name <> "H" Then
　　　　　　k = k + 1
　　　　　　ReDim Preserve SAry(1 To k)
　　　　　　SAry(k) = Worksheets(i).Name
　　　　End If
　 Next i

こうすればいいかな？
これでは「H」という名前のシート以外全部削除です。
必要な数だけ条件をandでくっつけてもらってやればいいと思います。
これだと、シートの順番関係なしで、指定したシート以外のシートを削除になります。
【25482】Re:削除指定の仕方
発言  ichinose  - 05/6/1(水) 22:10 -
引用なし
パスワード
   こんばんは、みなさん。
つんさんとKeinさんのコードをお借りして

'====================================================
Sub main()
　 Dim SAry() As String
　 Dim stt As Long
　 Dim edd As Long
　 Dim Eidx As Long
　 Dim Hidx As Long
　 Dim retcode As Long
　 On Error Resume Next
　 retcode = 0
　 Eidx = Worksheets("E").Index
　 If Err.Number <> 0 Then retcode = 1
　 Hidx = Worksheets("H").Index
　 If Err.Number <> 0 Then retcode = 1
　 If retcode = 0 Then
　　　stt = WorksheetFunction.Min(Eidx, Hidx)
　　　edd = WorksheetFunction.Max(Eidx, Hidx)
　　　For i = stt + 1 To edd - 1
　　　　 ReDim Preserve SAry(stt To i - 1)
　　　　 SAry(i - 1) = Worksheets(i).Name
　　　　 Next i
　　　If edd > stt + 1 Then
　　　　 Application.DisplayAlerts = False
　　　　 Worksheets(SAry()).Delete
　　　　 Application.DisplayAlerts = True
　　　　 End If
　　Else
　　　MsgBox "「E」　又は　「H」というシート名がありません"
　　　End If
End Sub

試してみて下さい
【25531】Re:削除指定の仕方
お礼  rough  - 05/6/3(金) 13:56 -
引用なし
パスワード
   ずばり上手くいきました。
皆さんどうもありがとうございました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
9792 / 13657 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free