vba - VBAで行をグループ化する

Question

動作していないように見える以下のコードがあります。基本的に、rngListExcelで定義された名前の範囲を指します。これは約500行の長さで、すべてnの行数にテキストがあります（500行のうち約32行にテキストがあります）。空白以外のセルに移動しようとしています（ctrl + downExcelのコマンドを模倣しています）。

それらが空白であるかどうか、および空白であるかどうかを確認して、そのセルをグループ化します。空白でない場合は左側のセルを確認し、0の場合はグループ化します。私が今持っているコードは本質的にこれを行おうとしていますが、以下のエラーが表示されます：

Group Method of Range Class Failed

次に、次の行を強調表示します。

Selection.Rows.Group

編集：空白の行をグループ化する代わりに、1を含む行をグループ化するとします。そうすれば、crtl + downは、最後の行ではなく、実際にはそのセルに移動します。

助けてくれてありがとう！

コードは以下のとおりです。

rngList.Cells(1).Select
    i = 0

    Do While i < 32
        i = i + 1
        If Selection.Value = "" Then
            Selection.Rows.Group
        Else
            Selection.End(xlToLeft).Select
                If Selection.Value <> 0 Then
                    Selection.Rows.ClearOutline
                End If
        End If
        Selection.End(xlToRight).Select
        Selection.End(xlDown).Select

    Loop

Answer 1

この投稿の年齢にもかかわらず、私はそれにつまずくかもしれない人のために私の2セントを投入すると思いました。私はあなたの質問を正しく理解することを望みます。これが私が集めたものです：

目標：対象の列のすべての行について、基準に基づいて行をグループ化します。

基準：rows in the group値がない（空白、null、空）か、値があり、値が0の隣接セル（すぐ左）があるrows not in the groupものだけです。空白ではなく、 0ではない隣接セル。

サンプルデータは次のとおりです。

注：範囲は、OPが言っているようにB1:B12、名前付き範囲を構成します。rngList

マクロを実行する前のデータ：

マクロ実行後のデータ-折りたたまれていないグループ化：

マクロ実行後のデータ-グループ化は折りたたまれています：

これを処理するコード：

このコードを機能させるには：VBE（Visual Basic Editor）で、グループ化するデータ（名前付き範囲も含むrngList）を含むワークシートを開き、このコードを貼り付けてから、マクロを実行します。

注：コメントは、特定の部分をさらに詳細に説明するために追加されていますが、コード自体はそれ自体を説明できる方法で記述されていると思います（たとえば、変数名は意味があり、ロジックは意味があります）。

Public Sub GroupCells()
    Dim myRange As Range
    Dim rowCount As Integer, currentRow As Integer
    Dim firstBlankRow As Integer, lastBlankRow As Integer
    Dim currentRowValue As String
    Dim neighborColumnValue As String

    'select range based on given named range
    Set myRange = Range("rngList")
    rowCount = Cells(Rows.Count, myRange.Column).End(xlUp).Row

    firstBlankRow = 0
    lastBlankRow = 0
    'for every row in the range
    For currentRow = 1 To rowCount
        currentRowValue = Cells(currentRow, myRange.Column).Value
        neighborColumnValue = Cells(currentRow, myRange.Column - 1).Value

        If (IsEmpty(currentRowValue) Or currentRowValue = "") Then
            'if cell is blank and firstBlankRow hasn't been assigned yet
            If firstBlankRow = 0 Then
                firstBlankRow = currentRow
            End If
        ElseIf Not (IsEmpty(currentRowValue) Or currentRowValue = "") Then
            'if the cell is not blank and its neighbor's (to the left) value is 0,
            'and firstBlankRow hasn't been assigned, then this is the firstBlankRow
            'to consider for grouping
            If neighborColumnValue = 0 And firstBlankRow = 0 Then
                firstBlankRow = currentRow
            ElseIf neighborColumnValue <> 0 And firstBlankRow <> 0 Then
                'if firstBlankRow is assigned and this row has a value with a neighbor
                'who isn't 0, then the cell one row above this one is to be considered
                'the lastBlankRow to include in the grouping
                lastBlankRow = currentRow - 1
            End If
        End If

        'if first AND last blank rows have been assigned, then create a group
        'then reset the first/lastBlankRow values to 0 and begin searching for next
        'grouping
        If firstBlankRow <> 0 And lastBlankRow <> 0 Then
            Range(Cells(firstBlankRow, myRange.Column), Cells(lastBlankRow, myRange.Column)).EntireRow.Select
            Selection.Group
            firstBlankRow = 0
            lastBlankRow = 0
        End If
    Next
End Sub

Answer 2

私はSamのコードを使用して、列Aを使用せずにグループ化しました。他の人がそれを役立つと思うかもしれません。

Sub Group_Jobs()

Dim myRange As Range
Dim rowCount As Integer, currentRow As Integer
Dim firstBlankRow As Integer, lastBlankRow As Integer
Dim currentRowValue As String
Dim nextRowValue As String

Application.ScreenUpdating = False 'Stop screen updating while grouping

'select range based on given named range
Set myRange = Range("A1:A1000")
rowCount = Cells(Rows.Count, myRange.Column).End(xlUp).Row

firstBlankRow = 0
lastBlankRow = 0

'for every row in the range
For currentRow = 1 To rowCount
    currentRowValue = Cells(currentRow, myRange.Column).Value
    nextRowValue = Cells(currentRow + 1, myRange.Column).Value

'Assign firstBlankRow & lastBlankRow
    'if currentRowValue = NotBlank(Job#) And nextRowValue = NotBlank(Job#) Then Skip
    'if currentRowValue = Blank          And nextRowValue = Blank          Then Skip
    'if currentRowValue = NotBlank(Job#) And nextRowValue = Blank          Then is firstBlankRow
    'if currentRowValue = Blank          And nextRowValue = NotBlank(Job#) Then is lastBlankRow
    If Not (currentRowValue = "" Or currentRowValue = "") Then
        If (IsEmpty(nextRowValue) Or nextRowValue = "") Then
            firstBlankRow = currentRow + 1
        End If
    ElseIf (IsEmpty(currentRowValue) Or currentRowValue = "") Then
        If Not (IsEmpty(nextRowValue) Or nextRowValue = "") Then
            If firstBlankRow <> 0 Then
                lastBlankRow = currentRow
            End If
        End If
    End If
    Debug.Print "Row " & currentRow; ": firstBlankRow: " & firstBlankRow; ", lastBlankRow: " & lastBlankRow

'Group firstBlankRow & lastBlankRow
    'if first & last blank rows have been assigned, create a group
    If firstBlankRow <> 0 And lastBlankRow <> 0 Then
        'Debug.Print "Row: " & currentRow; ", Outline Level: " & ActiveSheet.Rows(currentRow).OutlineLevel
        If Not ActiveSheet.Rows(currentRow).OutlineLevel > 1 Then 'Ignore if last row is already grouped
            Range(Cells(firstBlankRow, myRange.Column), Cells(lastBlankRow, myRange.Column)).EntireRow.Select
            Selection.Group
        End If
        firstBlankRow = 0: lastBlankRow = 0 'reset the first/lastBlankRow values to 0
    End If
Next

Application.ScreenUpdating = True 'Start screen updating as macro is complete
End Sub