[[20240225105945]]　『空白行のグループ化』（Ty）　ページの最後に飛ぶ

『空白行のグループ化』（Ty）

マクロで　B列およびD列ともに空白の行をグループ化をしたい
例題の　8行目～13行目、24行目～25行目を　各グループ化する
お教えください
よろしくお願いします

     |[B]       |[C]|[D]       
 [1] |          |   |          
 [2] |東京      |   |大阪      
 [3] |東京一郎  |   |大阪四郎  
 [4] |東京次郎  |   |大阪五郎  
 [5] |東京三郎  |   |大阪一郎  
 [6] |東京四郎  |   |大阪次郎  
 [7] |          |   |大阪三郎  
 [8] |          |   |          
 [9] |          |   |          
 [10]|          |   |          
 [11]|          |   |          
 [12]|          |   |          
 [13]|          |   |          
 [14]|名古屋    |   |福岡      
 [15]|名古屋一郎|   |福岡一郎  
 [16]|名古屋次郎|   |福岡次郎  
 [17]|名古屋三郎|   |福岡三郎  
 [18]|名古屋四郎|   |福岡桜子  
 [19]|名古屋五郎|   |福岡楓    
 [20]|          |   |福岡由紀恵
 [21]|          |   |福岡四郎  
 [22]|          |   |福岡五郎  
 [23]|          |   |福岡花子  
 [24]|          |   |
 [25]|          |   |          
 [26]|札幌      |   |京都      
 [27]|札幌三郎  |   |京都四郎  
 [28]|札幌四郎  |   |京都五郎  
 [29]|札幌五郎  |   |京都花子  
 [30]|札幌花子  |   |京都桃子  
 [31]|札幌桃子  |   |          
 [32]|札幌桜子  |   |          
 [33]|札幌楓    |   |          
 [34]|札幌由紀恵|   |          
 [35]|          |   |

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

 参考になりますか?
 Sub test()
     Dim rng1 As Range
     Dim rng2 As Range

     Set rng1 = Range([A1], Cells(Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow
     Set rng2 = Range([B1], Cells(Rows.Count, "B").End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow
     Debug.Print Intersect(rng1, rng2).Address
 End Sub
 必要に応じて、空白セルが無い場合のエラー対応を追加してください。
（xyz） 2024/02/25(日) 12:39:26

 ああ、列が違っていました。修正してください。
 グループ化というのが曖昧ですが、
 .Areasで各エリアのコレクションが得られます。
（xyz） 2024/02/25(日) 12:46:19

 アウトラインのことかしら？
（稲葉） 2024/02/25(日) 12:50:39

そうです
アウトラインです
うまく説明ができなく　すみません

（Ty） 2024/02/25(日) 12:57:52

隠居Z　様
ありがとうございました

できました

差分の方で見ました

（Ty） 2024/02/25(日) 13:48:53

m(__)m
一部無駄が？不具合かも？？等が有り。。。点検の為取り下げておりました。。。m(__)m
のちほど
修正分あげておきますです。もっと良い方法があるかもです。
他の回答者様のご案内もお待ちくださいませ。。。でわ
<< _ _ >>

（隠居Z） 2024/02/25(日) 14:31:41

 Option Explicit
Sub OneInstanceMain()
    Dim i             As Long
    Dim cnt           As Long
    Dim lR            As Long
    Dim r             As Range
    Dim rr            As Range
    Dim sy            As Long
    Dim ey            As Long
    With Worksheets("Sheet1")
        lR = .Cells(.Rows.Count, 2).End(xlUp).Row
        Set rr = .Range(.Cells(1, 2), .Cells(lR, 4))
    End With
    rr.ClearOutline
    For i = 2 To lR
        If rr(i, 1) = "" And rr(i, 3) = "" Then
            cnt = cnt + 1
            If cnt = 1 Then sy = i
        Else
            If cnt > 0 Then
                ey = i - 1
                Set r = rr.Rows(sy & ":" & ey)
                r.Rows.Group
                cnt = 0
            End If
        End If
    Next
    Worksheets("Sheet1").Outline.ShowLevels RowLevels:=1
End Sub
（隠居Z） 2024/02/25(日) 14:43:19

ご丁寧に
ありがとうございました
（Ty） 2024/02/25(日) 15:49:37

 既に、トピ主さまの要望による...本物のアウトラインマクロは解決済みです。

 余興です。

 アウトラインでは、個別に行範囲を操作できるのが利点ですが
 一括で表示と非表示を切替するのも、場合によってはとっても便利ですね。

 では...まず、アウトラインを解除して

 Sub アウトライン一括クリア()
    Cells.ClearOutline
 End Sub

 それから（xyz）さん提案の続きをして遊んでみた。

 Sub test()
    Dim rng1 As Range, rng2 As Range
    Set rng1 = Range([B1], Cells(Rows.Count, "B").End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow
    Set rng2 = Range([D1], Cells(Rows.Count, "D").End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow
   'Debug.Print Intersect(rng1, rng2).Address(0, 0) ' 8:13,24:25
    Dim tmp As Variant, i As Long
    tmp = Split(Intersect(rng1, rng2).Address(0, 0), ",")
    For i = 0 To UBound(tmp)
        With Sheets("Sheet1").Rows(tmp(i))
            .Hidden = Not .Hidden
        End With
    Next i
 End Sub

 おしまい（笑）
（あみな） 2024/02/25(日) 16:19:15

 upし直しました。（セル範囲の特定方法は変わりませんが）
 Sub test()
     Dim rng1  As Range
     Dim rng2  As Range
     Dim r     As Range
     With Worksheets("Sheet1")
         Set rng1 = .Range([B2], .Cells(Rows.Count, "B").End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow
         Set rng2 = .Range([D2], .Cells(Rows.Count, "D").End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow
         For Each r In Intersect(rng1, rng2).Areas
             r.Group
         Next
         .Outline.ShowLevels RowLevels:=1
     End With
 End Sub
 # 既に回答いただいていましたが、折角なので。
（xyz） 2024/02/25(日) 16:33:16

皆様ありがとうございました

隠居Z　様のマクロで解決済ですが

xyz　様のマクロでは
13行目がグループ化
25行目がグループ化
37行目～45行目がグループ化
49行目～56行目がグループ化
となりました

希望は
24行目～25行目がグループ化
としたいのですが
です
後学のためお教えいただけるようでしたら
お願いします

あみな様のマクロでは
同じ個所が非表示になりました
(1行目除く)

（Ty） 2024/02/26(月) 09:43:49

 （Ty）さんへ

 私のは、アウトラインの設定はしないタイプです。
 単純に、B列とD列が空白行があるなら、非表示と表示を
 同一ボタンから切り替えると言った動作です。

 因みに、1行目は見出しがないのなら、下記は

 Set rng1 = Range([B2]
 Set rng2 = Range([D2]

 としないと対象の行になってしまいます。
（あみな） 2024/02/26(月) 10:20:33

みなさん　ありがとうございます

↑↑の説明訂正
誤
　希望は
　24行目～25行目がグループ化
　としたいのですが
正
　希望は
　8行目～13行目がグループ化
　24行目～25行目がグループ化
　としたいのですが

あみなさん
ご返事ありがとうございます
理解できました(非表示等)

ただ、非表示となった行が　13行目と25行目が選択された
マクロのどこの箇所で行指定されたのかが
理解できません

（Ty） 2024/02/26(月) 11:04:50

 ん？

 ＞ただ、非表示となった行が　13行目と25行目が選択された	
 ＞マクロのどこの箇所で行指定されたのかが理解できません

 それは、私に言っているのかな？それとも。。。	
 （xyz）さんなのか良く解りませんが…推定で^^;

 対象の行を、どうやって取得しているか？って事ならですが	
 SpecialCells(xlCellTypeBlanks)の部分で、私のも、（xyz）さんのも	
 取得しています。下記のような表があるとして

    |[A]|[B]	
 [1]|〇 |〇 	
 [2]|   |   	
 [3]|〇 |〇 	
 [4]|   |〇

 この表の範囲を、UsedRange で取得しているのですが	
 その中で、空白セルを下のマクロでは選択します。

 Sub 空白セルを取得選択する()	
    Dim rng As Range	
    Set rng = _	
    ActiveSheet.UsedRange.SpecialCells(xlCellTypeBlanks)	
    rng.Select	
 End Sub

 参考URL	
https://www.relief.jp/docs/excel-vba-find-blank-cells.html

 でもって、範囲を Set rng1 とSet rng2 に確保してから	
 私のは、Split くんと Intersect くんで頑張って貰って	
 tmp くんに格納してから、ループで処理しています。

 ↓ここです。	
 tmp = Split(Intersect(rng1, rng2).Address(0, 0), ",")

 ↓（xyz）さんのはここで処理していますね。	
 Intersect(rng1, rng2).Areas

 Intersectメソッドの　戻り値に 2列の中で、空白の対象行を	
（重なっている）部分を特定させていると言えばいいでしょうか。。

（あみな） 2024/02/26(月) 11:41:29

 あみなさん
 詳細の説明　ありがとうございます

 ※Intersectメソッドの　戻り値に 2列の中で、空白の対象行を	
　（重なっている）部分を特定させている

 となると最初の表では
 8行目～13行目が対象となります。

 しかし　8行目のみが非表示されます(8行目～13行目が空白重なっているが)
 その辺がわかりません

 　
（Ty） 2024/02/26(月) 12:27:17

 ええ...こちらでは、B列とD列に　同じ行が空白なら
 って条件でちゃんと、8行目から13行目迄が、私のも

 非表示と表示を切替できますけど。
 因みに、（xyz）さんのもちゃんとなるかと思いますが。。。

 もしかして、B列とD列の 9行目から13行目のどちらかに
 数式で空白がありませんか？
（あみな） 2024/02/26(月) 12:40:04

 あみなさん、コメントいただきありがとうございました。お手数かけました。

 不思議ですね。
 空白に見えて空白ではないセルがあるような気がします。
 ・最初の行から、データのある最終行までの４列を選択したうえで、
 ・「検索と選択」の「ジャンプ」-　「セル選択」機能を使って、「空白セル」を指定
 してみて下さい。 想定したとおりのセルが空白セルとして選択されていますか?
 # 手元で仕様どおりの結果が得られたことを確認して投稿しています。

 念のため、こういった確認をされると理解が進むかもしれません。
     With Worksheets("Sheet1")
         Set rng1 = .Range([B2], .Cells(Rows.Count, "B").End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow
         Set rng2 = .Range([D2], .Cells(Rows.Count, "D").End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow
         Debug.Print rng1.Address                    ' add
         Debug.Print rng2.Address                    ' add
         Debug.Print Intersect(rng1, rng2).Address   ' add
         For Each r In Intersect(rng1, rng2).Areas
             Debug.Print r.Address                   ' add
             r.Group
         Next
         .Outline.ShowLevels RowLevels:=1
     End With
     '変数宣言等は不要ということではなく、投稿にあたって単に記載を省略しただけです。 
（xyz） 2024/02/26(月) 12:49:43

あみなさん、xyzさん
ご迷惑をおかけしました。

該当行をデリートして
確認しましたら　できました

個々において理解できました
ありがとうございました
（Ty） 2024/02/26(月) 12:56:51

 deleteする前に確認して原因を追究すべきではなかったですか？
 提示したコードは実行してもらったのでしょうか。そんな短時間で検討できるんですか。
 結果オーライでなく、原因をよく追及して欲しかったです。何度も繰り返してしまう懸念があります。

（xyz） 2024/02/26(月) 13:18:19

 ※deleteする前に確認して原因を追究すべきではなかったですか？
 すみません

 ※提示したコードは実行してもらったのでしょうか。そんな短時間で検討できるんですか
 （あみな） 2024/02/26(月) 12:40:04　のあとすぐに
 あみなさんのコードと　xyzさんのコードを実行し確認はしました

 ※結果オーライでなく、原因をよく追及して欲しかったです。何度も繰り返してしまう懸念があります
 事前に空欄の確認をしてなかった等を
 十分反省し今後に生かします。
 ご指導を感謝します
（Ty） 2024/02/26(月) 13:35:04

xyz　さんへ

 ※・「検索と選択」の「ジャンプ」-　「セル選択」機能を使って、「空白セル」を指定
 してみて下さい。 想定したとおりのセルが空白セルとして選択されていますか?

 今確認しました

 ご指摘どおり　B8ほか空白にみえても　空白となっていませんでした
 該当セルをダブルクリックしたあと　実質空白としました。
 なぜそのように状態になったか、思い出すことができませんでした
 今後ともよろしくお願いします

（Ty） 2024/02/26(月) 13:56:06

 思い出しました

 例題の表で各名前を作成した時、&　で作成し
 値で貼り付けしました。
 それが影響しました
（Ty） 2024/02/26(月) 14:04:31

コメント返信：

[ 一覧(最新更新順) ]

[[20240225105945]] 『空白行のグループ化』（Ty） ページの最後に飛ぶ

[[20240225105945]]　『空白行のグループ化』（Ty）　ページの最後に飛ぶ