Página 1 de 1

Problemas com Alinhamento de Linhas

Enviado: 10 Jan 2019 às 11:46
por rohden1969
Prezados Colegas, Boa Tarde!

Estou com um problema em uma planilha onde ao lançar os dados na coluna B6:B12 e B15:B17, estes lançamentos automaticamente são lançados no intervalo C6:C12 e C15:C17 via macro. Até aí sem problemas. O que está errado é que ao passar todos estes para um ticket final (intervalo I6:I17) o qual é impresso no fechamento, os lançamentos não estão "batendo" a descrição e o valor correspondente.

Alguém aí pode me dar um auxílio? Acredito que deva ser um problema de fácil resolução mas eu não consigo "enxergar" a solução.

Grato,
Sandro.

Problemas com Alinhamento de Linhas

Enviado: 10 Jan 2019 às 22:15
por Jimmy
Olá Sandro,

Na fórmuma da célula J2, altere o intervalo $A$6:$A$20 (ele aparece 3 vezes) por $C$6:$C$20. Não tecle ENTER após a alteração pois é uma fórmula matricial. Segure SHIFT+CTRL e só então tecla ENTER. Uma vez acertada, copie-a para baixo.

Me permite dar palpites na macro do evento CHANGE.

Sua Macro:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B6:B12,B15:B17,R4:R14]) Is Nothing Then Exit Sub
On Error Resume Next
Target.Offset(, 1).Value = Target.Offset(, 1).Value + Target.Value
Application.EnableEvents = False
Target.Value = ""
Application.EnableEvents = True
End Sub


Minha versão:
If Not Intersect(Target, [B6:B12,B15:B17,R4:R14]) Is Nothing Then
On Error Resume Next
For Each Cel In Intersect(Target, [B6:B12,B15:B17,R4:R14])
Cel.Offset(, 1).Value = Cel.Offset(, 1).Value + Cel.Value
Even = Application.EnableEvents
Application.EnableEvents = False
Cel.Value = ""
Application.EnableEvents = Even
Next
End If
End Sub


Quatro comentários principais
1) Pense que amanhã pode haver uma outra necessidade de evento CHANGE, para uma outra finalidade que não tem nada a ver com esta. Se você, neste evento, a encerrar com EXIT SUB, nada dalí pra frente rodará. Seria bom se habituar a fazer com que a rotina seja executada dentro de um IF, se for o caso. Se não for, o IF não executa a rotina, mas também não a encerra, podendo haver outros diversos ifs abaixo, responsáveis por outras demandas.

2) tenha em mente que TARGET é um RANGE que geralmente tem uma só célula, mas pode ter mais. Imagine que o usuário digite o valor 3 na célula F3. COmo não pertence à faixa de atuação da SUB, nada ocorre. Ai ele tecla CTRL-C (copiar), seleciona B8:B12 e CTRL-V (colar). TARGET será um RANGE que contém 5 células. Logo, você deve processar EACH CEL IN TARGET.

3) Você não deve reativar os eventos após executar essa SUB ( Application.EnableEvents = True), e nem deve deixá-los desativados. Você deve deixá-los coom estavam. Lembre-se que essa macro pode ser parte de um sistema muito maior, com diversas macros, etc. O melhor é sempre se habituar a armazenar o status dos eventos, depois desativá-los, fazer o que for necessário, e por último deixá-los como foram encontrados. Isso é feito assim:
Even = Application.EnableEvents 'Guarda o status atual
Application.EnableEvents = False 'Desabilita
Target.Value = "" 'Faz o que precisa ser feito
Application.EnableEvents = Even 'Deixa como estava
[/color]

4) Para um SUB que roda tão pouco, algumas centenas de vezes por dia, eu nem desligaria os eventos. Deixaria rodar. Isso gasta processamento, mas é tão pouco que não vale a pena desligar. Em vez de desligar, eu evitaria o loop infinito quando você apaga a célula (cel.Value = "") com mais um IF, só fazendo algo se houver valor maior que zero em CEL. Assim, quando apaga CEL, o evento CHANGE é iniciado, mas não faz nada! Morre logo.
Qual a vantagem disso? Macros sempre poder dar pau, abortar, ou até serem canceladas pelo usuário. Se você desativa os eventos e a macro, por azar, é interrompida antes de reativá-lo, o usuário ficará sem eventos. Geralmente, por não saber outra forma de fazer, e após perceber que há algo errado, ele sairá da planilha e a abrirá novamente.
Eu eliminei a intervenção da macro nos eventos, e ficou assim:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [B6:B12,B15:B17,R4:R14]) Is Nothing Then
On Error Resume Next
For Each cel In Intersect(Target, [B6:B12,B15:B17,R4:R14])
If cel.Value > 0 Then
cel.Offset(, 1).Value = cel.Offset(, 1).Value + cel.Value
cel.Value = ""
End If
Next
End If
End Sub


Jimmy San Juan

Re: Problemas com Alinhamento de Linhas

Enviado: 11 Jan 2019 às 00:05
por Jimmy
Sandro,

Achei que as observações que fiz a respeito da sua macro CHANGE, poderiam servir para outros usuários.
Por isso, criei um post no grupo de DICAS, comentando o caso.

http://gurudoexcel.com/forum/viewtopic. ... 015#p40015

Tem algo lá, a respeito do ON ERROR RESUME NEXT / ON ERROR GOTO 0 que não coloquei aqui pra você pois só me ocorreu mais tarde.
Dá uma olhada lá, ok?

Até

Jimmy San Juan