Este fórum está sendo desativado

[SandroLima]

Boa tarde, colegas do fórum

Tenho uma planilha que retorna os gastos e o responsável pelo pagamento em tabelas distintas (tabelas-destino) conforme o grupo em que se enquadram os itens na tabela Condomínio (tabela-origem).

Preciso de um código que redimensione a tabela conforme a quantidade de itens a serem listados.

Para dimensionar a quantidade de itens de cada grupo tenho uma tabela auxiliar na aba CONDOMINIO que pode ser usada para informar o número do contador de linhas de cada tabela destino.

Preciso que ao início dessa Macro o código limpe os dados das tabelas MANTENDO FÓRMULAS E FORMATAÇÕES e exclua da PRIMEIRA ATÉ A PENÚLTIMA LINHA de cada tabela de destino.

Fiz um esboço do código que dá uma direção do que o código precisa realizar. Está na forma de um módulo mas acredito que deva ser mudado para um evento change da planilha uma vez que preciso que ele execute a cada alteração nos intervalos "MesReferencia_RelMensal" e "AnoReferencia_RelMensal" da aba RELATORIO MENSAL.

É claro que o código apresenta erro e também não sei se essa é a forma de fazê-lo... como disse é apenas um esboço do que eu necessito.

Segue planilha anexa para testes e implementação.

Obrigado desde já a quem puder colaborar.

[babdallas]

Veja se é isso.

[SandroLima]

Bom dia, babdallas.

É exatamente isso... resolveu o meu problema. Adaptei para minha planilha e funciona perfeitamente.

Apenas preciso incorporar aquela msg de " Não existem lançamentos para o período selecionado" quando não houver e ele não executar a sub mantendo as tabelas de destino sem alteração.

Gostaria MUITOOO que comentasse essa parte do código para mim... esse modelo de construção não estou habituado.
Entendo como funciona mas não sei interpretar.

Código: Selecionar todos

Private Sub Redimensiona(lobTab As ListObject, lngQtdeLinhas As Long)
    Dim lngCont     As Long
    
    With lobTab
        If .ListRows.Count > 1 Then
            For lngCont = .ListRows.Count To 2 Step -1
                .DataBodyRange.ListObject.ListRows(lngCont).Delete
            Next lngCont
        End If
        
        For lngCont = 2 To lngQtdeLinhas
            .ListRows.Add
        Next lngCont
    End With
End Sub

Inclusive a declaração de variáveis no cabeçalho da Sub.

E esse código também se puder:

Código: Selecionar todos

Private Sub Worksheet_Change(ByVal Target As Range)
    If wshRelMensal.Range("MesReferencia_RelMensal").Address = Target.Address Then RedimensionaTabela
End Sub

Nele você não fez menção ao intervalo "AnoReferencia_RelMensal"... não há necessidade?

Muito obrigado desde já.

[babdallas]

Segue a subrotina comentada.

Código: Selecionar todos

Private Sub Redimensiona(lobTab As ListObject, lngQtdeLinhas As Long)
'Esta subrotina recebe um objeto Tabela e uma variável de quantidade de linhas que este objeto Tabela deve ter.
'Baseado nisso, ela deleta da 2? linha da tabela até a última, deixando apenas a primeira linha para não retirar as formulas contidas na Tabela.
'Depois, a subrotina adiciona o número de linhas necessário para que tenha a mesma quantidade de linhas informada pela variável lngQtdeLinhas.

    'Declaração de variáveis
    Dim lngCont     As Long 'Contador
    
    With lobTab
        'Verifica se a tabela possui mais de uma linha. Se possuir apenas uma linhas, não precisa deletar nada.
        'Se possuir mais de uma linha, deleta da ultima linha até a linha 2.
        If .ListRows.Count > 1 Then
            For lngCont = .ListRows.Count To 2 Step -1
                .DataBodyRange.ListObject.ListRows(lngCont).Delete 'Este é o código que encontrei para deletar a linha que desejo
            Next lngCont
        End If
        
        
        'Após excluir as linhas, adiciona as linhas da linha 2 até o numero de linhas da Tabela
        For lngCont = 2 To lngQtdeLinhas
            .ListRows.Add
        Next lngCont
    End With
End Sub

Altere a subrotina do evento Change da planilha para o seguinte:

Código: Selecionar todos

[code]Private Sub Worksheet_Change(ByVal Target As Range)
'Esta subrotina é um evento que ocorre na planilha ao mudar qualquer célula da planilha wshRelMensal.
'É uma subrotina que escolho no menu do VBE e gera a primeira (Private Sub....) e a última (End Sub) de forma automática.
'Target é a variável que foi modificada e que, ao ser modificada, ativa este evento.
'Target é passada como valor (ByVal), ou seja, seus valores e suas propriedades não serão modificados nesta subrotina.

'Nesta subrotinha é comparado se a célula modificada (Target) é o mesmo endereço o intervalo nomeado
'MesReferencia_RelMensal ou AnoReferencia_RelMensal. Se for um deste dois intervalos, redimensiona as Tabelas.

    If wshRelMensal.Range("MesReferencia_RelMensal").Address = Target.Address Or _
        wshRelMensal.Range("AnoReferencia_RelMensal").Address = Target.Address Then RedimensionaTabela
End Sub

[/code]

De qualquer forma, veja o arquivo em anexo e veja as modificações. Espero ter ficado claro.

[SandroLima]

Bom dia, babdallas.

Após as adequações para a minha planilha ficou excelente.

Eliminei as linhas do código:

Código: Selecionar todos

wshRelMensal.Range("MesReferencia_RelMensal").Value = strMes
            wshRelMensal.Range("AnoReferencia_RelMensal").Value = lngAno

Pois a minha planilha atualiza o mês e ano para a data atual no evento WorkBook _Open e nem sempre há lançamentos (principalmente início do mês) para o período) o que provocava erro ao abrir a planilha.

Mas resolvi dessa maneira e ficou ótimo.

Muito obrigado mais uma vez e obrigado também pelas explicações... ficou bem claro.