Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Procedimento Muito ...
 
Notifications
Clear all

Procedimento Muito Grande - VBA

 
2024 - VBA & Macros
Post Recente por Miquéias 10 anos atrás
7 Posts
2 Usuários
0 Reactions
2,545 Visualizações
RSS
 Miquéias
(@miqueias)
Posts: 17
Active Member
Topic starter
 

Boa tarde pessoal, pesquisei em vários tópicos e sites e não consegui achar a solução. Nunca programei em VBA mas como gostei de mexer com isso criei um código para baixa de estoque, direto na planilha, quando digito um valor na G7 da Plan 2, a A7 da Plan 1 recebe como soma, quando digito um valor na Plan 2 a A7 da Plan 1 recebe como subtração. Os nomes dos produtos eu especifico na tabela da própria planilha, sem muita frescura. O código abaixo vai até a linha 2.250, e o excel exibe o erro ao digitar na célula que o "procedimento é muito grande". Tem como reduzir isso? To quebrando a cabeça a tempo pesquisando alguma solução e não acho. Agradeço a ajuda, abraços!

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = Range("G7").Address Then
Sheets("Resumo").Cells(7, "A") = Sheets("Resumo").Cells(7, "A") + Sheets("Movimentações").Cells(7, "G")
Sheets("Movimentações").Cells(7, 7).Select

End If
If Target.Address = Range("H7").Address Then
Sheets("Resumo").Cells(7, "A") = Sheets("Resumo").Cells(7, "A") - Sheets("Movimentações").Cells(7, "H")
Sheets("Movimentações").Cells(7, 8).Select
End If

If Target.Address = Range("G8").Address Then
Sheets("Resumo").Cells(8, "A") = Sheets("Resumo").Cells(8, "A") + Sheets("Movimentações").Cells(8, "G")
Sheets("Movimentações").Cells(8, 7).Select

 
Postado : 23/06/2014 12:20 pm
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Sem maiores detalhes, presumo que a evolução seja linear, se assim for experimente assim:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 7 And Target.Row > 6 Then
Sheets("Resumo").Cells(Target.Row, "A") = Sheets("Resumo").Cells(Target.Row, "A") + Sheets("Movimentações").Cells(Target.Row, "G")
Sheets("Movimentações").Cells(Target.Row, 7).Select

End If
If Target.Address = 8 And Target.Row > 6 Then
Sheets("Resumo").Cells(Target.Row, "A") = Sheets("Resumo").Cells(Target.Row, "A") - Sheets("Movimentações").Cells(Target.Row, "H")
Sheets("Movimentações").Cells(Target.Row, 8).Select
End If
End Sub

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

 
Postado : 23/06/2014 1:26 pm
 Miquéias
(@miqueias)
Posts: 17
Active Member
Topic starter
 

Pois é, só que o problema é que continuaria na mesma, pois continuaria com o mesmo número de linhas para resolver...
Obrigado pelo retorno rápido.

Fico no aguardo de mais alguma dica.

 
Postado : 23/06/2014 4:03 pm
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Creio que não entendeu. São somente essas linhas (Veja que acrescentei o end sub, para "mostrar" o final da rotina).
Qualquer alteração na coluna acima da linha 6 "dispara" a rotina. O numero da linha é alimentado/detectado pela modificação na planilha.
Se não for isso, monte um modelo significativo de sua planilha /código e detalhes que julgar pertinente e poste-o aqui no fórum

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

 
Postado : 23/06/2014 5:26 pm
 Miquéias
(@miqueias)
Posts: 17
Active Member
Topic starter
 

Humm, blz.
Deu erro na linha 13, tipo incompatíveis, aponte nesse código:

If Target.Address = 8 And Target.Row > 6 Then

 
Postado : 23/06/2014 5:57 pm
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Há um erro no que passei, no segundo if altere:
De: If Target.Address = 8
Para: If Target.Column = 8

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

 
Postado : 23/06/2014 6:02 pm
 Miquéias
(@miqueias)
Posts: 17
Active Member
Topic starter
 

Ok, achei que fosse isso, já mudei e testei o código.
Ficou perfeito, se tivesse falado com você antes não tinha perdido meu find.

kkk

Valeu cara, grande abraço!

 
Postado : 23/06/2014 6:15 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico