[[20160527081343]]　『行列グループ化の判定をしてグループ化又はグルー』（たぬき）　ページの最後に飛ぶ

『行列グループ化の判定をしてグループ化又はグループ解除する方法』（たぬき）

行・列のグループ化において、選択した行・列がグループ化されているかどうかを判定してグループ化されている場合はグループ化解除、グループ化されていない場合はグループ化する。といったマクロを作成したいと思っています。これの結合・結合解除バージョンは作成できたのですが、行・列のグループ化バージョンが作成できなかったのでご教示ください。

ちなみに結合・結合解除は下記の様に作成しました。
これのグループ化がどう書き換えればいいのかわからずです。。。

Sub MergeUnMerge()
If ActiveCell.MergeCells = True Then

      If ActiveCell.MergeCells = True Then Selection.UnMerge
    Else
      If ActiveCell.MergeCells = False Then Selection.Merge
    End If
End Sub

＜使用 Excel：unknown、使用 OS：unknown ＞

追記ですがシートにシート保護がかかっており、
シート保護を解除してからグループ化の判定してグループ化又はグループ化解除を行い再度シート保護をかけるというコードにしたいと思っています。追加ですみませんが良ければ教えてください。
（たぬき） 2016/05/27(金) 08:25

 質問のテーマからはずれて恐縮ですが、アップされたコードでは

 If ある条件 Then
    If ある条件 Then なになに
 Else
    If 反対の条件 Then これこれ
 End Sub

 になっていますね。なんだか、くすぐったい感じがしますね。
 ふつうに

 If ある条件 Then
    なになに
 Else 
    これこれ
 End Sub

 でよろしいですよ。

 ついでに、追加でアップされた保護の件、保護をする、保護を解除する、この２つの操作をマクロ記録しましょう。
 そうすると、必要なコードが生成されますよ。

（β） 2016/05/27(金) 08:34

Bさんとても分かりやすい説明ありがとうございます。

シート保護の件は前後に組み合わせて使用してみたときにうまくいかなかったのですが、
よくよく確認してみたら勘違いしていたことに気が付き結合バージョンは下記コードで
解決致しました。これのグループ化バージョンを作成したいと思っています。

Sub 結合()
Const PSWD = "sss"
ActiveSheet.Unprotect Password:=PSWD
If ActiveCell.MergeCells = True Then

      Selection.UnMerge
    Else
      Selection.Merge
    End If
ActiveSheet.Protect Password:=PSWD, _
            Contents:=True, _
            UserInterfaceOnly:=True, _
            DrawingObjects:=False, _
            AllowFormattingCells:=True, _
            AllowFormattingColumns:=True, _
            AllowFormattingRows:=True, _
            AllowInsertingHyperlinks:=True, _
            AllowInsertingColumns:=True, _
            AllowInsertingRows:=True, _
            AllowSorting:=True, _
            AllowFiltering:=True
ActiveSheet.EnableOutlining = True
ActiveSheet.EnableSelection = xlNoRestrictions
End Sub
（たぬき） 2016/05/27(金) 08:54

 選択されたセル領域の列、あるいは行がグループ化されているかどうかの判定に関する参考コードを書いてみました。

 ただ、グループ化されていたとして、そのグループ全体が、何行目から何行目なのか、あるいは何列目から何列目なのかの
 情報は、さがしてみましたが見つかりませんでした。

 それがないと、グループ化解除の範囲が特定できないので、コードとして、こまってしまいますねぇ・・

 上級者さんからの回答を待ちましょう。

 Sub Sample列()
    Dim z As Range
    Dim n As Variant

    Set z = Selection.EntireColumn
    n = z.OutlineLevel

    If IsNull(n) Then
        MsgBox "グループ化されている列とされていない列があります"
    Else
        If n > 1 Then
            MsgBox "選択列がグループ化されています"
        Else
            MsgBox "選択列はグループ化されていません"
        End If
    End If

 End Sub

 Sub Sample行()
    Dim z As Range
    Dim n As Variant

    Set z = Selection.EntireRow
    n = z.OutlineLevel

    If IsNull(n) Then
        MsgBox "グループ化されている行とされていない行があります"
    Else
        If n > 1 Then
            MsgBox "選択行がグループ化されています"
        Else
            MsgBox "選択行はグループ化されていません"
        End If
    End If

 End Sub

（β） 2016/05/27(金) 17:33

 グループ化領域の取得、いい方法が思い浮かばなかったので、力技です。
 任意のセル領域を選択して Test行　あるいは　Test列　を実行してください。
 選択されたセル領域の列ないしは行がグループ化されているかどうか、されているとすれば、そのセル領域が属するグループ全体の領域はどこかを
 メッセージします。

 Sub Test列()
    Dim ans As Boolean
    Dim grp As Range

    ans = getGroup(Selection.EntireColumn, grp)

    If ans Then
        If grp Is Nothing Then
            MsgBox "グループ化されていません"
        Else
            MsgBox "グループ化されています" & vbLf & "グループ領域は" & grp.Address & "です"
        End If
    Else
        MsgBox "グループ化されている列とされていない列が混在しています"
    End If

 End Sub

 Sub Test行()
    Dim ans As Boolean
    Dim grp As Range

    ans = getGroup(Selection.EntireRow, grp)

    If ans Then
        If grp Is Nothing Then
            MsgBox "グループ化されていません"
        Else
            MsgBox "グループ化されています" & vbLf & "グループ領域は" & grp.Address & "です"
        End If
    Else
        MsgBox "グループ化されている行とされていない行が混在しています"
    End If

 End Sub

 Function getGroup(r As Range, grp As Range) As Boolean
    Dim r1 As Range
    Dim r2 As Range
    Dim x As Long
    Dim func As XlSearchOrder
    Dim n As Variant
    Dim w As Variant

    Set grp = Nothing

    If r.Columns.Count = Columns.Count Then
        func = xlByRows
    Else
        func = xlByColumns
    End If

    n = r.OutlineLevel
    If IsNull(n) Then
        getGroup = False
        Exit Function
    ElseIf n < 2 Then
        getGroup = True
        Exit Function
    End If

    If func = xlByColumns Then
        Set r1 = r.Columns(1)
        Set r2 = r.Columns(r.Columns.Count)
        For x = IIf(r.Column = 1, 1, r.Column - 1) To 1 Step -1
            If Columns(x).OutlineLevel < 2 Then Exit For
            Set r1 = Columns(x)
        Next
        For x = r2.Column To Columns.Count
            If Columns(x).OutlineLevel < 2 Then Exit For
            Set r2 = Columns(x)
        Next
    Else
        Set r1 = r.Rows(1)
        Set r2 = r.Rows(r.Rows.Count)
        For x = IIf(r.Row = 1, 1, r.Row - 1) To 1 Step -1
            If Rows(x).OutlineLevel < 2 Then Exit For
            Set r1 = Rows(x)
        Next
        For x = r2.Row To Rows.Count
            If Rows(x).OutlineLevel < 2 Then Exit For
            Set r2 = Rows(x)
        Next
    End If

    getGroup = True
    Set grp = Range(r1, r2)

 End Function

（β） 2016/05/27(金) 23:56

 アップしたコードで必要な部分を、必要なところに組み込めば
 そちらがやりたいことが達成できると思いますが、その『そちらのやりたいこと』が
 クリアには理解していないので具体的に回答することができません。

 おそらくは、セル範囲は何でもいいのですが、たとえば　F5:H10 が選択されていたとして
 F:H がグループ化されていれば 『グループ化解除』、されていなければ『グループ化』したいと読み取れます。

 １．行　または　列　ということですけど、行を処理とか列を処理とか、そう決めて処理するのか？
 　　行　および　列　両方を一度に処理したいのか？

 ２．たとえば　F:H がグループ化されていたとして、実態は A:K がグループ化されていて F:Hは
 　　その中の一部分だった場合には、どうしたいのか？　F:Hのみをグループ化解除したいのか？
 　　それが属するグループ A:K全体をグループ化解除したいのか？

 ３．たとえば A:G がグループ化されていて、Hはグループ化されていない状態の時はどうしたいのか？

 ４．２，３では列を例に挙げましたけど、行についても同様のことがいえます。

 アップされたセル結合処理コードにも、ちょっと『あやうさ』が内包されています。
 たとえば　A1:C3 が結合、E1:G3 が結合されている状態で A1:G3 を選択して実行すると
 アクティブセルは A1。これは結合セルなので　結合解除。 そうすると、E1:G3 の結合もはずれる。
 これが意図されているならＯＫですけど。

 あるいは　E1:G3 のみ結合されている。　ここで A1:G3を選んで処理すると　アクティブセルである A1 は結合セルではないので
 選択領域の A1:G3 全体が結合される。元々結合されていた E1:G3 、コードの意図が『結合されている領域は結合解除』なら
 ここは結合解除されるべき？　でも、より大きな結合領域の中の一部分になる。

 まぁ、こんな操作はしないということなんでしょうけど、コードとしては（あるいは仕様としては）あやうい感じがします。

（β） 2016/05/28(土) 17:41

 もう１つコメントしておきます。

 UserInterfaceOnly:=True は万能ではありません。
 たとえばマクロによる条件付書式の条件削除は可能ですが条件設定はエラーになります。
 オートフィルター関連処理にも、許可条件を設定したとしても操作はＯＫだけどマクロからの操作が不可能なところがあったと記憶しています。
 で、今回のグループ化も、その『万能ではない』機能の一部になってしまうと思います。
 （ためしてみてください）

（β） 2016/05/28(土) 18:29

 コメントしたようにシート保護に関しては
 ・実行前に保護解除
 ・実行後に再保護
 が（今回の場合は）よろしいかと思います。

 で、先にコメントした通り、『本当の要件』が見えないのですが、
 アップ済みのコードをベースにして、たたき台として書いてみました。新規ブックで試してみてください。

 なお、セル範囲ではなく、処理したい『列範囲』ないしは『行範囲』を選択して実行してください。

 Sub Test()
    Const PSWD = "sss"
    Dim r As Range
    Dim er As Boolean
    Dim func As XlSearchOrder
    Dim nosR As Long
    Dim nosC As Long
    Dim ans As Boolean
    Dim grp As Range

    If TypeName(Selection) = "Range" Then
        If Selection.Areas.Count = 1 Then
            nosR = Selection.Rows.Count
            nosC = Selection.Columns.Count
            If nosR <> Rows.Count Or nosC <> Columns.Count Then
                If nosR = Rows.Count Then
                    func = xlByColumns
                    Set r = Selection.EntireColumn
                ElseIf nosC = Columns.Count Then
                    func = xlByRows
                    Set r = Selection.EntireRow
                End If
            End If
        End If
    End If

    If func = 0 Then
        MsgBox "行範囲　あるいは　列範囲を１か所のみ選択して実行してください"
        Exit Sub
    End If

    ans = getGroup(r, grp, func)

    If ans Then

        '=====
        '必要ならここでシート保護解除
        '=====

        If grp Is Nothing Then
            r.Group
        Else
            grp.Ungroup
        End If

        '=====
        '必要ならここでシート保護
        '=====

    Else
        MsgBox "選択範囲にグループ化されているところとグループ化されていないところがあるため処理できません"
    End If

 End Sub

 Function getGroup(r As Range, grp As Range, func As XlSearchOrder) As Boolean
    Dim r1 As Range
    Dim r2 As Range
    Dim x As Long
    Dim n As Variant
    Dim w As Variant

    Set grp = Nothing

    n = r.OutlineLevel
    If IsNull(n) Then
        getGroup = False
        Exit Function
    ElseIf n < 2 Then
        getGroup = True
        Exit Function
    End If

    If func = xlByColumns Then
        Set r1 = r.Columns(1)
        Set r2 = r.Columns(r.Columns.Count)
        For x = IIf(r.Column = 1, 1, r.Column - 1) To 1 Step -1
            If Columns(x).OutlineLevel < 2 Then Exit For
            Set r1 = Columns(x)
        Next
        For x = r2.Column To Columns.Count
            If Columns(x).OutlineLevel < 2 Then Exit For
            Set r2 = Columns(x)
        Next
    Else
        Set r1 = r.Rows(1)
        Set r2 = r.Rows(r.Rows.Count)
        For x = IIf(r.Row = 1, 1, r.Row - 1) To 1 Step -1
            If Rows(x).OutlineLevel < 2 Then Exit For
            Set r1 = Rows(x)
        Next
        For x = r2.Row To Rows.Count
            If Rows(x).OutlineLevel < 2 Then Exit For
            Set r2 = Rows(x)
        Next
    End If

    getGroup = True
    Set grp = Range(r1, r2)

 End Function

（β） 2016/05/28(土) 19:05

Bさんご親切に色々ありがとうございます。
ちょっと今から試してみたいと思います。

（たぬき） 2016/05/29(日) 12:16

コメント返信：

[ 一覧(最新更新順) ]

[[20160527081343]] 『行列グループ化の判定をしてグループ化又はグルー』（たぬき） ページの最後に飛ぶ

[[20160527081343]]　『行列グループ化の判定をしてグループ化又はグルー』（たぬき）　ページの最後に飛ぶ