Notifications
Clear all

Macro para listar valores e controlar quantidade de linhas.

3 Posts
3 Usuários
0 Reactions
888 Visualizações
(@andre_neto)
Posts: 0
New Member
Topic starter
 

Boa tarde, pessoal.

Preciso de uma ajuda com um macro.
Tenho uma aba Base onde trago alguns ítens com quantidade de peças importadas e quantidade de peças nacionais e uma outra aba que preciso alimentar apenas com o nome dos produtos que possuem peças importadas (diferente de zero).

1- Preciso que na aba Aplicacao sejam listadas na coluna B todas os itens (nomes) apresentadas na aba Base, que contenham quantidade de peças importadas (diferente de zero). Lembrando que no restante das colunas da mesma linhas já existem formulas que trarão os demais valores da tabela Base.
2-Preciso que na aba Aplicacao sejam acrescentadas linhas conforme a quantidade de itens (com peças importadas), trazendo as formulas das demais colunas (da mesma linha) para que o cálculo seja mantido quando o macro trouxer os itens listados na coluna B.
3-Preciso que na aba Aplicacao sejam excluídas as linhas que estiverem sobrando na tabela, de forma que a tabela fique toda completa com a quantidade de itens com peças importadas e as formulas envolvidas.

Na planilha já tenho um macro passado por um amigo que adiantou muito o trabalho, porém a mesma não traz as formulas quando a linha é acrescentada e a mesma repete um dos intens quando executamos o macro mais de uma vez.

O link da planilha: http://www.4shared.com/file/AFdtXFgHce/Exemplo_Plan1.html

Macro dentro da aba Aplication:

Sub ListaItensAcrescentaLinhas()
 Dim wsB As Worksheet, wsO As Worksheet, rngE As Range
 Dim K As Long, rO As Long, rB As Long, m As Long, N As Range
  Set wsB = Worksheets("BASE"): Set wsO = Worksheets("APLICACAO")
  'rO = wsO.Range("B4:B" & wsO.Range("B4").End(xlDown).Row).Rows.Count - 1
   rO = Application.CountIf(wsO.Range("B4:B" & wsO.Range("B4").End(xlDown).Row), "<>TOTAL")
   rB = Application.CountIf(wsB.Range("C4:C" & wsB.Range("C4").End(xlDown).Row), ">0") - 1
    If rB - rO > 0 Then wsO.Rows(4).Resize(rB - rO).Insert
    If rO - rB > 0 Then wsO.Rows(4).Resize(rO - rB).Delete
  For Each rngE In wsB.Range("C4:C" & wsB.Range("C4").End(xlDown).Row - 1)
   If rngE.Value > 0 Then
    wsO.Cells(K + 4, 2) = wsB.Cells(rngE.Row, 1)
    wsO.Cells(K + 4, 3).Resize(, 1).Value = wsB.Cells(rngE.Row, 3).Resize(, 3).Value
  '  wsO.Cells(K + 4, 4).Resize(, 1).Value = "=SEERRO(PROCV(B" & Target.Row & ";'C - EST.+CONS.'!$A$4:$AQ$23;6;FALSO); " - ")"
    K = K + 1
   End If
  Next rngE
End Sub
 
Postado : 07/03/2016 4:16 pm
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde André

Seja bem-vindo ao fórum!

Como você é novato no fórum, para facilitar a tua participação, sugiro tomar conhecimento do conteúdo dos links abaixo:

viewtopic.php?f=7&t=203
viewtopic.php?f=7&t=7903
viewtopic.php?f=7&t=3841
viewtopic.php?f=7&t=16757
viewtopic.php?f=7&t=12600
viewtopic.php?f=7&t=3371

Como participo de vários fóruns, estou acompanhando o teu tópico no outro fórum, onde você postou uma planilha de exemplo e depois que o Osvaldo perdeu tempo em criar um código e você não conseguir usar na tua planilha, pois a estrutura dela é diferente, acabou entregando que o arquivo não era igual ao que você havia postado.
Link para o fórum:
http://www.scriptbrasil.com.br/forum/to ... a-de-cima/

Tenha em mente que os fóruns são gratuito e dependem da boa vontade de seus usuários em ajudarem e contribuírem com seus conhecimentos gratuitamente, portanto, não os faça perder tempo, sempre anexe um exemplo com a estrutura igual a planilha real.

Patropi - Moderador

 
Postado : 08/03/2016 10:14 am
(@mprudencio)
Posts: 0
New Member
 

Olhei o link que o Patropi postou e pelo que li la sua duvida aqui é a mesma que vc tenta solução aqui, entao vou te dar uma solução que é a mais acertada nestes casos.

NUNCA, EU DISSE NUNCA CRIE UMA TABELA ABAIXO DE OUTRA POR MENOR QUE ELA SEJA ISSO VAI DAR PROBLEMA EM ALGUM MOMENTO, se precisa de varias tabelas na mesma aba, o ideal é que seja em abas separadas, coloque uma ao lado da outra, nunca abaixo

Graficos devem ficar sempre em abas em separado.

 
Postado : 08/03/2016 10:53 am