Excel VBA質問箱 IV

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

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


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

【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 -

引用なし
パスワード
   1つのブックに複数のシートがあるとして、
先頭シート(仮に名前を"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)があり2番目にダミーの空シート(H)、3番目にもダミーの空シート(E)があります。日毎に新データの書き込まれたシートが3番目のシート前に挿入されて行きます。便宜上新たなシート名を順番に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 -

引用なし
パスワード
   ずばり上手くいきました。
皆さんどうもありがとうございました。

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