[[20150706155319]]　『VBA　もしセルが空白なら複数シート削除』（未知の世界）　ページの最後に飛ぶ

『VBA　もしセルが空白なら複数シート削除』（未知の世界）

いつもお世話になっております。
また躓いてしまいました。

【シート名】入力・シート1・シート2・シート3・シート4・シート5
　　　　　　のように6つのシートがあるとします。

【入力シート】A9,A11,A13,A15,A17のセルにある番号を記入していきます。
条件１。A11,A13,A15,A17のセルが空白なら、シート1のみ残す(シート2～5はシート削除)

条件２。A13,A15,A17のセルが空白なら、シート2のみ残す(シート1,3,4,5はシート削除)

条件３。A15,A17のセルが空白なら、シート3のみ残す(シート1,2,4,5はシート削除)

条件４。A17のセルが空白なら、シート4のみ残す(シート1,2,3,5はシート削除)

条件５。A9,A11,A13,A15,A17セルが全部空白でなかったら、シート5のみ残す(シート1,2,3,4はシート削除)

Sub test()

 Dim sh As Worksheet

 Set sh = Worksheets("入力")

 If sh.Range("A11", "A13", "A15", "A17") = "" Then
    Application.DisplayAlerts = False
    Worksheets(Array("シート2", "シート3", "シート4", "シート5")).Select
    ActiveWindow.SelectedSheets.Delete
    Application.DisplayAlerts = True

 ElseIf sh.Range("A13", "A15", "A17") = "" Then
    Application.DisplayAlerts = False
    Worksheets(Array("シート1", "シート3", "シート4", "シート5")).Select
    ActiveWindow.SelectedSheets.Delete
    Application.DisplayAlerts = True

　　　　　　・
　　　　　　・
　　　　　　・
End Sub

など上のコードは途中ですが、うまくいきません。
セレクトケースの方がいいのかな？と思って
そっちでも自分なりに作ったのですがうまくいきません。

初心者で申し訳ありませんがどなたご教授お願い致します。

＜使用 Excel：Excel2007、使用 OS：Windows7 ＞

 不要なものを削除、必要なものを残す　２つの方法がありますが、前者で。
 なお、「空白」とは、本当の空白という前提。（式などで "" になっている見かけの空白は空白とみなしません）

 Sub Test()    '指定シートを削除
    Dim v As Variant
    Dim r As Range

    With Sheets("入力")

        If GetBlankCell(Range("A9,A11,A13,A15,A17")) = 0 Then
            v = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4")
        ElseIf GetBlankCell(Range("A11,A13,A15,A17")) = 4 Then
            v = Array("Sheet2", "Sheet3", "Sheet4", "Sheet5")
        ElseIf GetBlankCell(Range("A13,A15,A17")) = 3 Then
            v = Array("Sheet1", "Sheet3", "Sheet4", "Sheet5")
        ElseIf GetBlankCell(Range("A15,A17")) = 2 Then
            v = Array("Sheet1", "Sheet2", "Sheet4", "Sheet5")
        ElseIf IsEmpty(Range("A17")) Then
            v = Array("Sheet1", "Sheet2", "Sheet3", "Sheet5")
        End If

        If IsArray(v) Then
            Application.DisplayAlerts = False
            On Error Resume Next
            Sheets(v).Delete
            On Error GoTo 0
            Application.DisplayAlerts = True
        End If

    End With

 End Sub

 Private Function GetBlankCell(r As Range) As Long
    Dim c As Range
    For Each c In r
        If IsEmpty(c) Then GetBlankCell = GetBlankCell + 1
    Next
 End Function

（β） 2015/07/06(月) 17:00

 残すべきシートを残すパターンもあげておきます。
 GetBlankCell はアップ済みのものを使います。

 Sub Test2()    '残すシートを特定
    Dim v As Variant
    Dim r As Range
    Dim sh As Worksheet
    Dim z As Variant

    With Sheets("入力")

        If GetBlankCell(Range("A9,A11,A13,A15,A17")) = 0 Then
            v = Array("入力", "Sheet5")
        ElseIf GetBlankCell(Range("A11,A13,A15,A17")) = 4 Then
            v = Array("入力", "Sheet1")
        ElseIf GetBlankCell(Range("A13,A15,A17")) = 3 Then
            v = Array("入力", "Sheet2")
        ElseIf GetBlankCell(Range("A15,A17")) = 2 Then
            v = Array("入力", "Sheet3")
        ElseIf IsEmpty(Range("A17")) Then
            v = Array("入力", "Sheet4")
        End If

        If IsArray(v) Then
            Application.DisplayAlerts = False
            For Each sh In Worksheets
                If IsError(Application.Match(sh.Name, v, 0)) Then sh.Delete
            Next
            Application.DisplayAlerts = True
        End If

    End With

 End Sub

（β） 2015/07/06(月) 19:45

さっそく解答くださったのにお返事遅くなってすみません。
ありがとうございます！！

上の段のを入れてみました。思う通りに動きました！
下の段はまだ試していませんが、上の段がまだ理解できなくて少し教えてください(>_<)

・GetBlankCellというのは…？
・後、Private Functionのところを簡単でいいので、どうか教えてください。

調べても、なかなか理解できずに…すみませんがどうかお願いいたします。

（未知の世界） 2015/07/07(火) 11:41

 たとえばシート関数に COUNTBLANK というものがありますね。領域の中の空白セルの数を求めます。
 ＶＢＡでもこの関数は WorksheetFunction.CountBlank(Range(なんたら)) として使うことができるのですが
 残念なことに、連続した領域指定しかできません。（今回のような　とびとびの領域のチェックができない）

 しょうがないので（？）複数とびとび領域指定可能な空白セルカウントの関数を自前で作りました。

 それが、GetBlankCell という関数で、ＶＢＡ内で　GetBlankCell(複数領域) と書くことにより、
 その領域内の空白の数を返します。このような関数を、ユーザー定義関数と呼びます。

 今、Private Function GetBlankCell(・・・　と記述しましたが、Private を取り除いて
 Function GetBlankCell(・・・　と直しておけば、シート上で　=GETBLANKCELL("A9,A11,A13") といった使い方もできます。
 （できるはずです）

 「ユーザー定義関数」あるいは「ファンクション　プロシジャ」でネット検索すると、解説ページがたくさんでてきますので
  是非、目を通しておいてください。

（β） 2015/07/07(火) 14:53

えっ、自前で作る！そんなことが！！すごいです。
いろいろネット検索しても出てこなくてしまいには自分の中でgetステートメントというのと
関係があるのだろうか…と思ってたんですけど、やっぱり聞いてよかったです。
（本当に無知で…お恥ずかしいです）

上記２つの検索ワードで検索してみて、今少しですが見てみました。
こちらの検索ワードを教えてくださり、とっっっっても助かります。
ぜひとも、時間あるときにいろんなところに目を通してみます。

本当にありがとうございました。<m(__)m>

（未知の世界） 2015/07/07(火) 16:11

コメント返信：

[ 一覧(最新更新順) ]

[[20150706155319]] 『VBA もしセルが空白なら複数シート削除』（未知の世界） ページの最後に飛ぶ

[[20150706155319]]　『VBA　もしセルが空白なら複数シート削除』（未知の世界）　ページの最後に飛ぶ