[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『行列グループ化の判定をしてグループ化又はグループ解除する方法』(たぬき)
行・列のグループ化において、選択した行・列がグループ化されているかどうかを判定してグループ化されている場合はグループ化解除、グループ化されていない場合はグループ化する。といったマクロを作成したいと思っています。これの結合・結合解除バージョンは作成できたのですが、行・列のグループ化バージョンが作成できなかったのでご教示ください。
ちなみに結合・結合解除は下記の様に作成しました。
これのグループ化がどう書き換えればいいのかわからずです。。。
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 >
質問のテーマからはずれて恐縮ですが、アップされたコードでは
If ある条件 Then If ある条件 Then なになに Else If 反対の条件 Then これこれ End Sub
になっていますね。なんだか、くすぐったい感じがしますね。 ふつうに
If ある条件 Then なになに Else これこれ End Sub
でよろしいですよ。
ついでに、追加でアップされた保護の件、保護をする、保護を解除する、この2つの操作をマクロ記録しましょう。 そうすると、必要なコードが生成されますよ。
(β) 2016/05/27(金) 08:34
シート保護の件は前後に組み合わせて使用してみたときにうまくいかなかったのですが、
よくよく確認してみたら勘違いしていたことに気が付き結合バージョンは下記コードで
解決致しました。これのグループ化バージョンを作成したいと思っています。
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 がグループ化されていれば 『グループ化解除』、されていなければ『グループ化』したいと読み取れます。
1.行 または 列 ということですけど、行を処理とか列を処理とか、そう決めて処理するのか? 行 および 列 両方を一度に処理したいのか?
2.たとえば F:H がグループ化されていたとして、実態は A:K がグループ化されていて F:Hは その中の一部分だった場合には、どうしたいのか? F:Hのみをグループ化解除したいのか? それが属するグループ A:K全体をグループ化解除したいのか?
3.たとえば A:G がグループ化されていて、Hはグループ化されていない状態の時はどうしたいのか?
4.2,3では列を例に挙げましたけど、行についても同様のことがいえます。
アップされたセル結合処理コードにも、ちょっと『あやうさ』が内包されています。 たとえば A1:C3 が結合、E1:G3 が結合されている状態で A1:G3 を選択して実行すると アクティブセルは A1。これは結合セルなので 結合解除。 そうすると、E1:G3 の結合もはずれる。 これが意図されているならOKですけど。
あるいは E1:G3 のみ結合されている。 ここで A1:G3を選んで処理すると アクティブセルである A1 は結合セルではないので 選択領域の A1:G3 全体が結合される。元々結合されていた E1:G3 、コードの意図が『結合されている領域は結合解除』なら ここは結合解除されるべき? でも、より大きな結合領域の中の一部分になる。
まぁ、こんな操作はしないということなんでしょうけど、コードとしては(あるいは仕様としては)あやうい感じがします。
(β) 2016/05/28(土) 17:41
もう1つコメントしておきます。
UserInterfaceOnly:=True は万能ではありません。 たとえばマクロによる条件付書式の条件削除は可能ですが条件設定はエラーになります。 オートフィルター関連処理にも、許可条件を設定したとしても操作はOKだけどマクロからの操作が不可能なところがあったと記憶しています。 で、今回のグループ化も、その『万能ではない』機能の一部になってしまうと思います。 (ためしてみてください)
(β) 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 "行範囲 あるいは 列範囲を1か所のみ選択して実行してください" 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
(たぬき) 2016/05/29(日) 12:16
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.