Este fórum está sendo desativado

[Isaiasdd]

Pessoal,

Tenho uma tabela com uma coluna que se chama "Níveis", preciso agrupar as linhas que estiverem entre os "Níveis" 1(UM).

Como na imagem abaixo, as linhas que estão em verde devem ficar ocultas (agrupadas), que quando o usuário clica no sinal do menos ali perto do número da linhas, fique visível somente os valores 1 (UM).



Tentei usar a seguinte macro:

Código: Selecionar todos

Sub AgruparNiveis()
    Dim tabela As ListObject
    Dim linha As ListRow
    
    Set tabela = Sheets("Plan1").ListObjects("Tabela_x")
    
    Dim inicioRange As Integer
    Dim fimRange As Integer
    
    For Each linha In tabela.ListRows
        If Intersect(linha.Range, tabela.ListColumns("Nivel").Range).Value = 1 Then
            If inicioRange = 0 Or inicioRange <> 0 Then
                inicioRange = linha.index + 1
            Else

            End If
        Else:
            fimRange = linha.index
        End If
    Next linha
End Sub

Porém comecei a ter problemas no for Each.

Alguma ideia de como pode se fazer isso?

[Isaiasdd]

Após um pouco de pesquisa encontrei uma macro que faça exatamente o que eu queria..

Algumas pequenas alterações e resolveu o problema.

segue a macro, se alguém precisar.

Código: Selecionar todos

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

    Set myRange = ActiveSheet.ListObjects("Tabela_x").ListColumns("Nivel").Range
    rowCount = Cells(Rows.Count, myRange.Column).End(xlUp).Row

    firstBlankRow = 0
    lastBlankRow = 0
    'Altera para a primeira linha da tabela
    For currentRow = 6 To rowCount
        currentRowValue = Cells(currentRow, myRange.Column).Value
        neighborColumnValue = Cells(currentRow, myRange.Column).Value

        If (IsEmpty(currentRowValue) Or currentRowValue > 1) Then
            If firstBlankRow = 0 Then
                firstBlankRow = currentRow
            End If
        ElseIf Not (IsEmpty(currentRowValue) Or currentRowValue > 1) Then
            If neighborColumnValue = 0 And firstBlankRow = 0 Then
                firstBlankRow = currentRow
            ElseIf neighborColumnValue <> 0 And firstBlankRow <> 0 Then
                lastBlankRow = currentRow - 1
            End If
        End If

        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

Segue link da macro original:

http://stackoverflow.com/questions/1333 ... ows-in-vba