[[20180312200627]]　『シートを全部抜き出して、選択して削除』（saya.suzuki）　ページの最後に飛ぶ

『シートを全部抜き出して、選択して削除』（saya.suzuki）

はじめまして。
関数では処理できなくて相談にきました。
よろしくお願いいたします。

ブック名　　月次データ

月次データの中に、毎月使用するシートが15ほど
(コードの一覧表、データ入力者名簿、備忘録など)、
これをグループＡとします。

それ以外に、月に作って、その月でもう不要になるシートがあります。
この、月だけで不要になるシートは、月によって不定で、
およそ25から50ほどになります。
すべて、3月4日購入、3月6日仕入れ、３月10日差し引き消費税など、
月日プラス文字となっています。
これをグループＢとします。

グループＢを作り終えた後に、
まとめた累積シート類が、月に1ないし2、作られます。
これをグループＣとします。

シートの並びは、グループＡ、Ｂ、Ｃの順です。

で、相談です。

この、ブック名　月次データ　の全シートを、

シート名　備忘録　の、Ｅ列３番目から、Ｅ列にシート順にすべてのシートを並べたい。

その上で、０月０日とつく、その月で不要になるシートをすべて削除したいのです。
その際、できれば、削除するデータを色づけして、視覚で確認した上で
自動消去できれば、と考えています。
よろしくご指導くださいませ。

＜使用 Excel：Excel2010、使用 OS：Windows8 ＞

う～んどうなんでしょう。

＞順にすべてのシートを並べたい
＞削除するデータを色づけして
セルの色付けは条件付き書式でなんとかなるかもしれませんが、シートの並び替えなんかはマクロを使わない方法が私には思いつかないです。

そして、マクロ（VBA）の質問であれば、マクロの記録をちょっと整理したくらいのものでも提示されていないと、仮に回答があっても理解できないんじゃないかと心配になりますし、丸投げなのかなというようにも思ってしまいます。
（もこな２） 2018/03/12(月) 21:31

＞その際、できれば、削除するデータを色づけして、視覚で確認した上で
＞自動消去できれば、と考えています。

確認するくらいなら、シート削除は手動でよいのでは。

＞シートの並びは、グループＡ、Ｂ、Ｃの順です。

順番通りなら、グループBだけを一括削除することは
手動でも手間はかからないと思いますが、こだわりますか。

（マナ） 2018/03/12(月) 21:33

あぁ・・・色付けしたいのはシート見出しですか。
であれば、そちらもマクロ以外の方法はわかりません・・・
（もこな２） 2018/03/12(月) 21:36

もう１つ確認です。

＞シート名　備忘録　の、Ｅ列３番目から、Ｅ列にシート順にすべてのシートを並べたい。

翌月は、前月分を消去して、またE3からですか。
それとも、前月分の下に続けるのですか？

（マナ） 2018/03/12(月) 21:41

まなさん、
翌月は、また、E列3列から並べたいです。

もこな2さん、途中までは、マクロは作ったので、
明日午前中に書き込みいたします。
少しはマクロの知識はあります。
よろしくご指導お願いいたします。
（saya.suzuki） 2018/03/12(月) 21:49

＞途中までは、マクロは作ったので、

であれば、書いちゃいましたがアップするはやめて
もこな２さんにおまかせしますね。

（マナ） 2018/03/12(月) 21:57

ここまではできたのですが、このあと、範囲色付け、削除でうまくいかず…。
よろしくお願いいたします。

Sub シート抜き出し

Dim mySheet As Worksheet
Dim myRow As Long

myRow = 4

For Each mySheet In Worksheets
Cells(myRow, 5).Value = mySheet.Name
myRow = myRow + 1
Next

End Sub

（saya.suzuki） 2018/03/13(火) 08:03

 ＞その際、できれば、削除するデータを色づけして、視覚で確認した上で

 ＞範囲色付け、削除でうまくいかず…

 ちょっと不明瞭に感じるんですけど・・

 色を付けるのは、セルですか？　シート見出しですか？

 ※ シート見出しは、データと言わないので。(普通は）

（半平太） 2018/03/13(火) 09:40

すいません。
削除するシートです。
グループBです。
よろしくお願いいたします。
（saya.suzuki） 2018/03/13(火) 10:07

＞その上で、０月０日とつく、その月で不要になるシートをすべて削除したいのです。
前月のブックをコピーして、
それを書き直してるのですか？
その発想がよくわからないです。

テンプレート（雛型）ファイルから必要な時に必要な物をコピーしてくれば良いような気がします。
そうすればどれが必要でどれが不要なのかなんて考えなくていいかと。。。

参考になれば。。。

＞削除するデータを色づけして、視覚で確認した上で
＞自動消去できれば、と考えています。
目視で確認するなら、マクロまで作らなくても、
グループ化してしまえばいいと思いますが？
（やり方はネットで調べてください）
（まっつわん） 2018/03/13(火) 10:41

私もよくわからなかったので、想像力をフルブーストしてこういうことですかね・・・
【グループA】
　　シート名がコードの一覧表、データ入力者名簿、備忘録などになってるシート
【グループB】
　　シート名に「*月*日*」と月日が含まれるシート
【グループC】
　　シート名が「累積*」ってなってるシート

【やりたいこと１】
＞この、ブック名　月次データ　の全シートを、シート名　備忘録　の、Ｅ列３番目から、Ｅ列にシート順にすべてのシートを並べたい。
↓
「月次データ.xlsm」の「備忘録」シートのE3以降に、全シート名を書き出したい

【やりたいこと２】
＞その上で、０月０日とつく、その月で不要になるシートをすべて削除したいのです。
＞その際、できれば、削除するデータを色づけして、視覚で確認した上で自動消去できれば、と考えています
↓
シート名に「０月０日」が含まれるシートのシート見出しに色を付けて、確認メッセージを出したあと、当該シートの削除をしたい。

MSGBOXで確認メッセージ出しちゃうとモードレスにできないっぽいので、確認メッセージ出すのにこだわるなら、ユーザーフォームで似た感じのものを作ってやる必要がありそうですが・・・
※マクロを記述するブックと、「月次データ」というブックの関係がわからないので、一部テキトーになってます。
Sub Sample()
'==変数の宣言など

    Dim mySheet As Worksheet
    Dim myRow As Long
    Dim delSH As New Collection
    Dim mes As Integer

'==処理

    'シート書き出し、見出し色付け
    myRow = 4
    For Each mySheet In Worksheets
        With mySheet
            Workbooks("月次データ.xlsm").Worksheets("備忘録").Cells(myRow, "E").Value = .Name
            If .Name Like "*０月０日*" Then
                .Tab.Color = RGB(255, 128, 128)
                delSH.Add Item:=Worksheets(.Name)
            End If
        End With
        myRow = myRow + 1
    Next

    'シート削除
    mes = MsgBox("見出しがピンク色のシートを削除します" & vbCrLf & "よろしいですか？", vbYesNo)
    If mes = 6 Then
         Application.DisplayAlerts = False
        For Each mySheet In delSH
            mySheet.Delete
        Next mySheet
         Application.DisplayAlerts = True
    End If
End Sub
（もこな２） 2018/03/13(火) 10:48

もこな2さん、ありがとうございます。

 If .Name Like "*０月０日*" Thenのところだけ、
手を加えさせていただきましたが、
無事、思っていたことができました。
ありがとうございます。
また、ほかの方々も、アドバイスをいただき、
大変感謝しております。
ありがとうございました。
（saya.suzuki） 2018/03/13(火) 12:20

 これも昨日せっかく書いたのでちょっと修正してUpしておきます。
Option Explicit
Sub てすと()
Dim ws As Worksheet
Dim MyTbl As Range
Dim MySh As String
Dim MyMsg() As Variant
Dim i As Long
Dim k As Long
ReDim x(1 To Sheets.Count)
Application.ScreenUpdating = False
    For Each ws In Worksheets
        MySh = StrConv(ws.Name, vbNarrow)
        Select Case True
            Case MySh Like "*ﾃﾞｰﾀ入力者名簿*"
                Sheets(ws.Name).Move Sheets(1)
            Case MySh Like "*ｺｰﾄﾞの一覧表*"
                Sheets(ws.Name).Move Sheets(1)
            Case MySh Like "*備忘録*"
                Sheets(ws.Name).Move Sheets(1)
            Case MySh Like "*累積*"
                Sheets(ws.Name).Move , Sheets(Sheets.Count)
            Case Else
                ws.Tab.Color = 65535
                k = k + 1
                ReDim Preserve MyMsg(1 To k)
                MyMsg(k) = ws.Name
        End Select
    Next
    For i = 1 To Sheets.Count
        x(i) = Sheets(i).Name
    Next
    With Sheets("備忘録")
        .Select
        Set MyTbl = .Range("E3", .Range("E" & .Rows.Count).End(xlUp))
        MyTbl.Clear
        .Range("E3").Select
        .Range("E3").Resize(UBound(x)).Value = Application.Transpose(x)
        With MyTbl
            .FormatConditions.Delete
            .FormatConditions.Add Type:=xlExpression, Formula1:="=SEARCH(""*月*日*"",$E3,1)>0"
            .FormatConditions(1).Interior.Color = 65535
        End With
        Application.Goto .Range("A1")
    End With
Application.ScreenUpdating = True
If vbYes = MsgBox("以下のシートを削除しますか？" & vbCrLf & vbCrLf & _
    Join(MyMsg, vbCrLf), vbYesNo + vbDefaultButton2) Then
    削除
End If
Set MyTbl = Nothing
Erase MyMsg, x
End Sub
Private Sub 削除()
Dim ws As Worksheet
Dim MySh As String
For Each ws In Worksheets
    MySh = StrConv(ws.Name, vbNarrow)
    If MySh Like "*月*日*" Then
        Application.DisplayAlerts = False
'            Sheets(ws.Name).Delete
        Application.DisplayAlerts = True
    End If
Next
End Sub
v(=∩_∩=)v
（SoulMan） 2018/03/14(水) 00:15

コメント返信：

[ 一覧(最新更新順) ]

[[20180312200627]] 『シートを全部抜き出して、選択して削除』（saya.suzuki） ページの最後に飛ぶ

[[20180312200627]]　『シートを全部抜き出して、選択して削除』（saya.suzuki）　ページの最後に飛ぶ