Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Contar células em o...
 
Notifications
Clear all

Contar células em outra planilha

 
2024 - VBA & Macros
5 Posts
4 Usuários
0 Reactions
1,654 Visualizações
RSS
 carloshvb
(@carloshvb)
Posts: 99
Trusted Member
Topic starter
 

Boa tarde pessoal,

Eu tenho duas planilhas onde uma é espelho da outra com campos diferentes para cada usuário trabalhar.

Meu problema, eu uso o código abaixo para aumentar a tabela onde o usuário insere os dados na planilha principal.
Porem, o usuário da planlha espelho é mais leigo e nem sempre tem noção de que precisa usar o código para igualar o tamanho das tabelas.

Por isso, eu gostaria de saber se é possível usar o VBA para verificar o tamanho da tabela da planilha principal, e se for o caso, já aumentar o tamanho da planilha espelho de forma automatizada.

Sub AumentarTabLista1()
'
' PLANILHA CONTROLE
' Redimensiona (aumenta) a Tabela com o Tamanho desejado
'
Set pCadastro = ActiveSheet

TabLista = "Tabela1" 'Controle

Application.ScreenUpdating = False
Call Desproteger

Li = Range(TabLista).Row                    'Linha Inicial
Ci = Range(TabLista).Column                 'Coluna Inicial
nCi = Range(TabLista).Columns.Count         'Número de Colunas
nLi = Range(TabLista).Rows.Count            'Número de Linhas na Tabela

Lf = Li + nLi - 1                           'Nº da última linha da tabela

'Número de Linhas a inserir
Título = "Redimensionamento da Tabela"
Mensagem = "Digite o Número de Linhas que deseja inserir:"
nL = InputBox(Mensagem, Título)

If nL = "" Then
    Call Proteger           'Atual
    Application.ScreenUpdating = True
    Exit Sub
End If

nL = Val(nL)

If nL <= 0 Or Not IsNumeric(nL) Then
    MsgBox "Número de Linhas Inválido! Fim da Execução!", vbCritical
    Call Proteger           'Atual
    Application.ScreenUpdating = True
    Exit Sub
End If

With pCadastro.ListObjects(TabLista)
        
    'Redimensionando a Tabela Filtrada
    .Resize Range(Cells(Li - 1, Ci), Cells(Lf + nL, Ci + nCi - 1))
    
End With

Call Proteger           'Atual
Application.ScreenUpdating = True
End Sub
 
Postado : 30/01/2018 2:27 pm
 MPrudencio
(@mprudencio)
Posts: 2749
Famed Member
 

Vc nao da detalhes de como é o arquivo, minha sugestão.

Crie uma planilha banco de dados e duas planilhas espelho, atualize o banco de dados pelo vba.

Marcelo Prudencio
Microsoft Excel Brasil no Facebook

"Começar já é a metade do caminho."
Autor Desconhecido

Simplifica que simples fica.
Nicole Tomazella.

"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.

 
Postado : 30/01/2018 4:42 pm
 carloshvb
(@carloshvb)
Posts: 99
Trusted Member
Topic starter
 

Desculpe Marcelo,

Achei ter dado todos os detalhes necessários.

Eu tenho duas planilhas formatadas como TABELA, e uso o código fornecido para aumentar o tamanho da tabela de acordo com a quantidade de linhas desejadas pelo usuário.

O que preciso é que uma destas planilhas verifique o tamanho da tabela da outra planilha e aumente sua tabela para ficar igual, não sei como dar mais detalhes.

OBS: refazer o trabalho não é uma opção atualmente, preciso apenas desta solução para incrementar o que já existe. Também não tenho conhecimento suficiente para criar um banco de dados em excel :(

De toda forma, obrigado

Att, Carlos

 
Postado : 31/01/2018 5:00 am
 klarc28
(@klarc28)
Posts: 971
Prominent Member
 

Para criar banco de dados:

https://www.youtube.com/results?search_query=excel+vba+criar+banco+de+dados

 
Postado : 31/01/2018 5:05 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bom dia!!

Opção 1: usar de forma automática, enquanto preenche a guia1 e tabela1, automaticamente a na guia2 e tabela2, será redimencionada.

Private Sub Worksheet_Change(ByVal Target As Range)
'Dentro do módulo de planilha use esse código
Dim rng As Range
Dim tbl As ListObject
Dim tb2 As ListObject

Set tb1 = Sheets("Plan1").ListObjects("Tabela1")
Set tb2 = Sheets("Plan2").ListObjects("Tabela2")

If tb1.Range.Rows.Count <> tb2.Range.Rows.Count Then
    Set rng = Sheets("Plan2").Range("Tabela2[#All]").Resize(tb1.Range.Rows.Count)
    tb2.Resize rng
End If

End Sub

Opção 2: Usar em modo sub rotina acionada por um botão.

Sub VersaoSub()
'Use um botão para atribuir essa subrotina
Dim rng As Range
Dim tbl As ListObject
Dim tb2 As ListObject

Set tb1 = Sheets("Plan1").ListObjects("Tabela1")
Set tb2 = Sheets("Plan2").ListObjects("Tabela2")

If tb1.Range.Rows.Count <> tb2.Range.Rows.Count Then
    Set rng = Sheets("Plan2").Range("Tabela2[#All]").Resize(tb1.Range.Rows.Count)
    tb2.Resize rng
End If

End Sub

Att

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 31/01/2018 5:33 am
Forum Jump:
  Tópico Anterior
Próximo Tópico