Notifications
Clear all

[Resolvido] Inserir automaticamente linhas de tabela, conforme definição do usuário.

3 Posts
2 Usuários
2 Likes
834 Visualizações
(@cesarm)
Posts: 8
Active Member
Topic starter
 

A situação é uma planilha que preencho com alguns dados iniciais e distribuo a vários usuários.
Alteram estes dados iniciais para analisar suas situações específicas.
No exemplo tenho uma célula que define p. ex. Qtde de meses =10 e uma tabela de meses e valores com 10 linhas.
Um usuário p. ex. altera a Qtde de meses de 10 para 15. Em seguida tem que inserir manualmente 5 linhas na tabela de meses e valores.
Questão: existe algum recurso para copiar automaticamente a linha 10 da tabela, 5 vezes ???
Vocês já me apresentaram soluções excelentes para outros problemas, facilitaram muito a vida dos usuários, que não tem muita prática de excel, estou procurando simplificar o máximo a vida deles.
Em anexo arquivo com descrição detalhada do problema.

 
Postado : 31/07/2022 8:54 pm
EdsonBR
(@edsonbr)
Posts: 1056
Noble Member
 

Da forma que vc pretende somente com programação VBA, @CesarM

No anexo, uma possível solução (não esqueça de permitir ativação de macro na abertura do arquivo).

O modelo aumenta (insere) ou diminui (deleta) a quantidade de linhas necessária conforme o valor inserido na B17.

Para ver o código, clique com o botão direito na "orelha" da planilha e escolha "Exibir Código".

O código usado foi esse:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim r As Range, qtLinsTab As Long
  If Target.Address = "$B$17" Then
    Set r = [C23].CurrentRegion
    qtLinsTab = r.Rows.Count - 3
    Set r = r.Rows(r.Rows.Count)
    Application.EnableEvents = False
    If [B17].Value > qtLinsTab Then
      r.Offset(-1).Copy
      Set r = r.Resize([B17].Value - qtLinsTab)
      r.Insert xlShiftDown
      Application.CutCopyMode = False
    ElseIf [B17].Value < qtLinsTab Then
      Set r = r.Offset([B17].Value - qtLinsTab).Resize(qtLinsTab - [B17].Value)
      r.Delete xlShiftUp
    End If
    Application.EnableEvents = True
  End If
End Sub

 
Postado : 01/08/2022 3:16 pm
CesarM reacted
(@cesarm)
Posts: 8
Active Member
Topic starter
 

Obrigado mais uma vez EdsonBR!
Imaginei que iria precisar de codificação.
Não tenho familiaridade com VBA, vou deixar registrada a solução para alguma oportunidade, se eu vier a estudar VBA.
Grato pela atenção e, de novo, pela qualidade da resposta.

 
Postado : 01/08/2022 11:54 pm
EdsonBR reacted