Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
controle de Compras
 
Notifications
Clear all

controle de Compras

 
Página 2 / 2
2024 - VBA & Macros
Post Recente por fazerbem 9 anos atrás
20 Posts
3 Usuários
0 Reactions
2,796 Visualizações
RSS
 fazerbem
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

Bem eu sou Representante comercial e trabalho com vendas as Lojas de Suplementos alimentares.

Minha planilha feita esta ok, e adicionada todas as Macros estas sim feitas com a ajuda deste Forum e tambem de outro Forum ( Guru do Excel ), criei agora uma Aba adicional em que pretendo controlar no Ano todos os pedidos feitos mês a mês pelas lojas.

Funcionaria assim:

Tenho uma Aba que ao ser executada ela pegaria por exemplo a celula ( E5 ) da Planilha Loja A e colaria o conteudo na Aba " Controle de Vendas " na Linha da Loja no mês atual.

CONTROLE DE VENDAS - 2016
Nome Fantasia Jan Fev Mar Abr Mai Jun Jul AGo Set Out Nov Dez TOTAL
Loja A ( 2 ) 1
Loja B 1 1
Loja C 1 1

Porem eu necessito que a Macro ao ser excutada verifique antes se ja Existe a Loja X, dentro da Aba Controle de Vendas, se SIM entao soma a celula do referido mês +1, por exemplo, digamos que este pedido foi gerado no mês de Janeiro e este ja é o segundo pedido desta loja A neste mesmo mês e Ano. Desta forma entao ja vai existir a Loja (A) e 1 pedido processado anteriormente, sendo assim a macro vai selecionar a mesma Loja e somar +1 ao seu conteudo.

Se NAO, a Macro Cria abaixo da ultima loja uma nova linha e adiciona o pedido.

Em total ja coloquei a formula em cada linha.

Obrigado se puderem ajudar.

Andre Luiz

 
Postado : 19/01/2016 8:26 am
 fazerbem
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

Nao tem uma macro com o nome atualizar no arquivo.

escrevi errado, é MACRO lancamento

Basta clicar no Botao Gerar Vendas.

 
Postado : 20/01/2016 1:53 pm
 fazerbem
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

Ok, agora foi, porem usando a dica do Ravargon, somente esta comendo as bordas da Celula, fora isso foi tudo certo !

Veja ai

porque esta comendo as bordas nao sei ainda

Sub Lancamento()

'dica usuario Ravargon

Sheets("RESUMO").Select

Application.ScreenUpdating = True

    Dim Ws2     As Worksheet
    Dim Dest    As Range
    
    Range("C3").Select
    Set Ws2 = Sheets("COMISSAO") 'Referencia a guia LANÇAR COMISSAO como Ws2
    Set Dest = Ws2.Range("B4").Range("B103").End(xlUp).Offset(1, -1) 'Encontra a ultima linha da guia comissão (definida como Dest)
    Range("A3:I3").Copy  'Copia o intervalo A2:H2 da guia Resumo
    Dest.PasteSpecial xlPasteValues                                  'Cola valores na guia Comissão
    Application.CutCopyMode = False                                  'Desativaj o clipboard

Sheets("RESUMO").Select

    Sheets("COMISSAO").Range("E4:E1000").Copy
    Sheets("VENDAS").Range("B8").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    Sheets("VENDAS").Range("$B$8:$B$1004").RemoveDuplicates Columns:=1, Header:=xlNo


'Run "Macro1"

End Sub
 
Postado : 20/01/2016 2:07 pm
 fazerbem
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

Segue resultado final faltando apenas resolver por que esta comendo as bordas em ABA VENDAS.

anexo, clicar na ABA RESUMO e no Botao Gerar Vendas !

Foi a unica forma que eu achei de poder ao final de cada mês poder zerar a Aba Comissao Vendas.

 
Postado : 20/01/2016 2:26 pm
 ravargon
(@ravargon)
Posts: 15
Active Member
 

Após alguma pesquisa ( https://www.youtube.com/watch?v=jWD1L9c3YUg ) e alguns testes consegui resolver o problema de apagar as bordas.

Fiz algumas mudanças no código para deixá-lo mais curto. Se preferir como estava, utilize apenas a parte final dele.

Sub Lancamento()

Sheets("RESUMO").Select

Application.ScreenUpdating = True

'Copia valores da guia Resumo
    Range("A3:I3").Copy  'Copia o intervalo A2:H2 da guia Resumo
    
'Cola valores na guia Lancar Comissao
    Sheets("LANCAR COMISSAO").Select 'Abre a guia LANÇAR COMISSAO
    Range("B4").Range("B1000").End(xlUp).Offset(1, -1).PasteSpecial xlPasteValues 'Encontra a ultima linha da guia Lancar Comissão e cola valores
    
'Cola valores na guia Comissao
    Sheets("COMISSAO").Select 'Abre a guia LANÇAR COMISSAO como Ws2
    Range("B4").Range("B1000").End(xlUp).Offset(1, -1).PasteSpecial xlPasteValues 'Encontra a ultima linha da guia Comissão e cola valores
    
'Dica Ravargon
    Sheets("VENDAS").Select 'Abre a guia Vendas
    Sheets("COMISSAO").Range("E4:E1000").AdvancedFilter Action:=xlFilterCopy, _
        CopyToRange:=Range("B8"), Unique:=True 'Copia lista de lojas e cola sem duplicados
    
    Sheets("RESUMO").Select 'Retorna à guia Resumo

End Sub

Anexei também a planilha com os testes que fiz.

Acho que é isso

Ramon Varela

 
Postado : 20/01/2016 11:49 pm
 fazerbem
(@fazerbem)
Posts: 697
Honorable Member
Topic starter
 

Ficou joia !

 
Postado : 21/01/2016 2:39 pm
Página 2 / 2
Forum Jump:
  Tópico Anterior
Próximo Tópico