Macro para selecionar linhas e agrupar

[Josevaldo Nergin]

E ai galera?!

Importo um relatorio para o excel que na coluna A vem com contas sinteticas e analiticas. Sendo as analiticas com 3 caracteres. As contas analiticas estão agrupadas totalizando na conta sintetica que esta imediatamente acima delas, conforme exemplo abaixo:

1

11

111

112

113

12

121

122

123

Sempre que importo o arquivo preciso marcar gurpo a grupo de linhas com 3 caracteres e fazer o agrupamento. Precisaria criar uma macro que reconhecesse os grupos de linhas analiticas e as agrupasse.

Alguem sabe me dizer como fazer essa macro?

Josevaldo

[jeffsilveira]

Josevaldo, seja bem vindo!

Por favor, poste um exemplo de sua planilha com dados fictícios. Use sendspace.com ou similar e cole o link aqui.

Demonstre na planilha a situação atual e como você quer que fique.

Lembre-se que você está habituado com sua planilha, mas nós nunca a vimos!

No aguardo.

[Josevaldo Nergin]

Muito obrigado!

A minha pergunta foi em como agrupar as contas analiticas que sao as que tem 9 digitos na planilha anexada.

Sendo que o tratamento completo consiste em:

1. Exluir os cabeçalhos

2. Agupar as contas analiticas

Coloquei a mensagem conforme voce solicitou segue link

http://www.sendspace.com/file/mdkayo

Abç

Josevaldo

[benzadeus]

Sub Exemplo()
    Const c_sResumo As String = "Resumo"

    Dim ws As Worksheet
    Dim r As Range
    Dim lRow As Long
    Dim lRowLast As Long
    Dim lRowStart As Long
    Dim lNível As Long

    Application.DisplayAlerts = False

    With ThisWorkbook
        Application.DisplayAlerts = False
        On Error Resume Next
        .Sheets(c_sResumo).Delete
        On Error GoTo 0
        Application.DisplayAlerts = False

        .Sheets("Importada").Copy Before:=.Sheets(1)
        Set ws = .Sheets(1)
        ws.Name = c_sResumo
    End With

    With ws
        .Outline.SummaryRow = xlAbove

        lRowLast = .Cells(.Rows.Count, "A").End(xlUp).Row
        For lRow = lRowLast To 1 Step -1
            Set r = .Cells(lRow, "A")
            If Not IsNumeric(r) Or IsEmpty(r) Then
                r.EntireRow.Delete
            End If
        Next lRow

        lRowLast = .Cells(.Rows.Count, "A").End(xlUp).Row
        For lNível = 1 To 5
            For lRow = 1 To lRowLast
                If Nível(.Cells(lRow, "A")) >= lNível Then
                    lRowStart = lRow
                    Do
                        lRow = lRow + 1
                    Loop While Nível(.Cells(lRow, "A")) > lNível
                    If lRow - lRowStart > 1 Then
                        .Rows(lRowStart + 1).Resize(lRow - lRowStart - 1).Group
                    End If
                End If
            Next lRow
        Next lNível
    End With

    Application.DisplayAlerts = True

End Sub

Private Function Nível(s As String) As Long
    Select Case Len(s)
        Case 1: Nível = 1
        Case 2: Nível = 2
        Case 3: Nível = 3
        Case 5: Nível = 4
        Case 9: Nível = 5
    End Select
End Function

[Josevaldo Nergin]

Muito Obrigado pela resposta.

O codigo esta criando varios niveis, sendo que somente preciso que as linhas com 9 caracteres sejam agrupadas. identifiquei dois pontos em que o nivel é citado:

For lNível = 1 To 5

Select Case Len(s)

Case 1: Nível = 1

Case 2: Nível = 2

Case 3: Nível = 3

Case 5: Nível = 4

Case 9: Nível = 5

Fiz duas alterações, deixando assim:

For lNível = 1 To 2

Select Case Len(s)

Case 1: Nível = 1

Case 9: Nível = 2

Ocorre que quando executo o codigo a primeira linha da sequencia nao esta sendo agruplada.

em que ponto do codigo é possivel corrigir esse problema?

marquei a responsta no MSDN.

Abraço!

Josevaldo

[benzadeus]

Não faça essa alteração, ela é necessária para o funcionamento do código. Ao invés disso, mude a linha

        For lNível = 1 To 5

para

        For lNível = 1 To 2