Somar e acrescentar valores em células diferentes

LaerteB · 5 de outubro de 2016

Boa tarde!

Desculpem a minha dúvida, pois sou iniciante em VBA no excel, bem a minha dúvida é que estou tentando fazer com que várias células somem valores que forem colocadas dentro delas mesmas.. exemplo: na célula A4 digito 10 e digito novamente na A4 um outro valor como 5, ele somará automaticamente para 15.

Quando volto nela que está com o valor de 15 digito mais 8 e a A4 ficará com 23.. e assim por diante.

Até aí eu fiz no VBA tirando exemplos na internet como se segue abaixo:

****

Public Sub Worksheet_Change(ByVal Target As Excel.Range)

'Este código acrescenta valores para a celula nao atendido

Static valorcel As Integer

Application.EnableEvents = False

If Target.Address = "$A$4" Then

valorcel = Target.Value + valorcel

If Target.Value = 0 Then valorcel = 0

Target.Value = valorcel

End If

Application.EnableEvents = True

End Sub

*********

Só que eu quero que se faço em outras células diferentes o mesmo procedimento, algumas em linha outras em coluna... nas células B4 - C4 - D4 - E4 - F4 - B13 - B14 e da F13 até F39, mas só funciona na primeira vez e quando eu salvo e fecho, abrindo novamente esta planilha não volta a somar mais na própria célula.

Abaixo como está esta programação que está dando este problema:

*****

Public Sub Worksheet_Change(ByVal Target As Excel.Range)

'Este código acrescenta valores para a celula nao atendido

Static valorcel As Integer

Application.EnableEvents = False

If Target.Address = "$A$4" Then

valorcel = Target.Value + valorcel

If Target.Value = 0 Then valorcel = 0

Target.Value = valorcel

End If

Application.EnableEvents = True

'Este código acrescenta valores para a celula nao chegou na unidade

Static valorcel2 As Integer

Application.EnableEvents = False

If Target.Address = "$B$4" Then

valorcel2 = Target.Value + valorcel2

If Target.Value = 0 Then valorcel2 = 0

Target.Value = valorcel2

End If

Application.EnableEvents = True

'Este código acrescenta valores para a celula nao localizado no fluxo postal

Static valorcel3 As Integer

Application.EnableEvents = False

If Target.Address = "$C$4" Then

valorcel3 = Target.Value + valorcel3

If Target.Value = 0 Then valorcel3 = 0

Target.Value = valorcel3

End If

Application.EnableEvents = True

'Este código acrescenta valores para a celula nao roubado

Static valorcel4 As Integer

Application.EnableEvents = False

If Target.Address = "$D$4" Then

valorcel4 = Target.Value + valorcel4

If Target.Value = 0 Then valorcel4 = 0

Target.Value = valorcel4

End If

Application.EnableEvents = True

'Este código acrescenta valores para a celula nao aguardando retirada

Static valorcel5 As Integer

Application.EnableEvents = False

If Target.Address = "$E$4" Then

valorcel5 = Target.Value + valorcel5

If Target.Value = 0 Then valorcel5 = 0

Target.Value = valorcel5

End If

Application.EnableEvents = True

'Este código acrescenta valores para a celula nao retirada em caixa postal

Static valorcel6 As Integer

Application.EnableEvents = False

If Target.Address = "$F$4" Then

valorcel6 = Target.Value + valorcel6

If Target.Value = 0 Then valorcel6 = 0

Target.Value = valorcel6

End If

Application.EnableEvents = True

'Este código acrescenta valores para a celula sexo masculino

Static valorcel7 As Integer

Application.EnableEvents = False

If Target.Address = "$B$13" Then

valorcel7 = Target.Value + valorcel7

If Target.Value = 0 Then valorcel7 = 0

Target.Value = valorcel7

End If

Application.EnableEvents = True

'Este código acrescenta valores para a celula sexo feminino

Static valorcel8 As Integer

Application.EnableEvents = False

If Target.Address = "$B$14" Then

valorcel8 = Target.Value + valorcel8

If Target.Value = 0 Then valorcel8 = 0

Target.Value = valorcel8

End If

Application.EnableEvents = True

'Este código acrescenta valores para a celula estado AC

Static valorcel9 As Integer

Application.EnableEvents = False

If Target.Address = "$F$13" Then

valorcel9 = Target.Value + valorcel9

If Target.Value = 0 Then valorcel9 = 0

Target.Value = valorcel9

End If

Application.EnableEvents = True

'Este código acrescenta valores para a celula estado AL

Static valorcel10 As Integer

Application.EnableEvents = False

If Target.Address = "$F$14" Then

valorcel10 = Target.Value + valorcel10

If Target.Value = 0 Then valorcel10 = 0

Target.Value = valorcel10

End If

Application.EnableEvents = True
'Este código acrescenta valores para a celula estado AP

Static valorcel11 As Integer

Application.EnableEvents = False

If Target.Address = "$F$15" Then

valorcel11 = Target.Value + valorcel11

If Target.Value = 0 Then valorcel11 = 0

Target.Value = valorcel11

End If

Application.EnableEvents = True

'Este código acrescenta valores para a celula estado AM

Static valorcel12 As Integer

Application.EnableEvents = False

If Target.Address = "$F$16" Then

valorcel12 = Target.Value + valorcel12

If Target.Value = 0 Then valorcel12 = 0

Target.Value = valorcel12

End If

Application.EnableEvents = True

'Este código acrescenta valores para a celula estado BA

Static valorcel13 As Integer

Application.EnableEvents = False

If Target.Address = "$F$17" Then

valorcel13 = Target.Value + valorcel13

If Target.Value = 0 Then valorcel13 = 0

Target.Value = valorcel13

End If

Application.EnableEvents = True

'Este código acrescenta valores para a celula estado CE

Static valorcel14 As Integer

Application.EnableEvents = False

If Target.Address = "$F$18" Then

valorcel14 = Target.Value + valorcel14

If Target.Value = 0 Then valorcel14 = 0

Target.Value = valorcel14

End If

Application.EnableEvents = True

'Este código acrescenta valores para a celula estado DF

Static valorcel15 As Integer

Application.EnableEvents = False

If Target.Address = "$F$19" Then

valorcel15 = Target.Value + valorcel15

If Target.Value = 0 Then valorcel15 = 0

Target.Value = valorcel15

End If

Application.EnableEvents = True

'Este código acrescenta valores para a celula estado ES

Static valorcel16 As Integer

Application.EnableEvents = False

If Target.Address = "$F$20" Then

valorcel16 = Target.Value + valorcel16

If Target.Value = 0 Then valorcel16 = 0

Target.Value = valorcel16

End If

Application.EnableEvents = True

'Este código acrescenta valores para a celula estado GO

Static valorcel17 As Integer

Application.EnableEvents = False

If Target.Address = "$F$21" Then

valorcel17 = Target.Value + valorcel17

If Target.Value = 0 Then valorcel17 = 0

Target.Value = valorcel17

End If

Application.EnableEvents = True

'Este código acrescenta valores para a celula estado MA

Static valorcel18 As Integer

Application.EnableEvents = False

If Target.Address = "$F$22" Then

valorcel18 = Target.Value + valorcel18

If Target.Value = 0 Then valorcel18 = 0

Target.Value = valorcel18

End If

Application.EnableEvents = True

'Este código acrescenta valores para a celula estado MT

Static valorcel19 As Integer

Application.EnableEvents = False

If Target.Address = "$F$23" Then

valorcel19 = Target.Value + valorcel19

If Target.Value = 0 Then valorcel19 = 0

Target.Value = valorcel19

End If

Application.EnableEvents = True

'Este código acrescenta valores para a celula estado MS

Static valorcel20 As Integer

Application.EnableEvents = False

If Target.Address = "$F$24" Then

valorcel20 = Target.Value + valorcel20

If Target.Value = 0 Then valorcel20 = 0

Target.Value = valorcel20

End If

Application.EnableEvents = True

'Este código acrescenta valores para a celula estado MG

Static valorcel21 As Integer

Application.EnableEvents = False

If Target.Address = "$F$25" Then

valorcel21 = Target.Value + valorcel21

If Target.Value = 0 Then valorcel21 = 0

Target.Value = valorcel21

End If

Application.EnableEvents = True

'Este código acrescenta valores para a celula estado PA

Static valorcel22 As Integer

Application.EnableEvents = False

If Target.Address = "$F$26" Then

valorcel22 = Target.Value + valorcel22

If Target.Value = 0 Then valorcel22 = 0

Target.Value = valorcel22

End If

Application.EnableEvents = True

'Este código acrescenta valores para a celula estado PB

Static valorcel23 As Integer

Application.EnableEvents = False

If Target.Address = "$F$27" Then

valorcel23 = Target.Value + valorcel23

If Target.Value = 0 Then valorcel23 = 0

Target.Value = valorcel23

End If

Application.EnableEvents = True

'Este código acrescenta valores para a celula estado PR

Static valorcel24 As Integer

Application.EnableEvents = False

If Target.Address = "$F$28" Then

valorcel24 = Target.Value + valorcel24

If Target.Value = 0 Then valorcel24 = 0

Target.Value = valorcel24

End If

Application.EnableEvents = True

'Este código acrescenta valores para a celula estado PE

Static valorcel25 As Integer

Application.EnableEvents = False

If Target.Address = "$F$29" Then

valorcel25 = Target.Value + valorcel25

If Target.Value = 0 Then valorcel25 = 0

Target.Value = valorcel25

End If

Application.EnableEvents = True

'Este código acrescenta valores para a celula estado PI

Static valorcel26 As Integer

Application.EnableEvents = False

If Target.Address = "$F$30" Then

valorcel26 = Target.Value + valorcel26

If Target.Value = 0 Then valorcel26 = 0

Target.Value = valorcel26

End If

Application.EnableEvents = True

'Este código acrescenta valores para a celula estado RJ

Static valorcel27 As Integer

Application.EnableEvents = False

If Target.Address = "$F$31" Then

valorcel27 = Target.Value + valorcel27

If Target.Value = 0 Then valorcel27 = 0

Target.Value = valorcel27

End If

Application.EnableEvents = True

'Este código acrescenta valores para a celula estado RN

Static valorcel28 As Integer

Application.EnableEvents = False

If Target.Address = "$F$32" Then

valorcel28 = Target.Value + valorcel28

If Target.Value = 0 Then valorcel28 = 0

Target.Value = valorcel28

End If

Application.EnableEvents = True

'Este código acrescenta valores para a celula estado RS

Static valorcel29 As Integer

Application.EnableEvents = False

If Target.Address = "$F$33" Then

valorcel29 = Target.Value + valorcel29

If Target.Value = 0 Then valorcel29 = 0

Target.Value = valorcel29

End If

Application.EnableEvents = True

'Este código acrescenta valores para a celula estado RO

Static valorcel30 As Integer

Application.EnableEvents = False

If Target.Address = "$F$34" Then

valorcel30 = Target.Value + valorcel30

If Target.Value = 0 Then valorcel30 = 0

Target.Value = valorcel30

End If

Application.EnableEvents = True

'Este código acrescenta valores para a celula estado RR

Static valorcel31 As Integer

Application.EnableEvents = False

If Target.Address = "$F$35" Then

valorcel31 = Target.Value + valorcel31

If Target.Value = 0 Then valorcel31 = 0

Target.Value = valorcel31

End If

Application.EnableEvents = True

'Este código acrescenta valores para a celula estado SC

Static valorcel32 As Integer

Application.EnableEvents = False

If Target.Address = "$F$36" Then

valorcel32 = Target.Value + valorcel32

If Target.Value = 0 Then valorcel32 = 0

Target.Value = valorcel32

End If

Application.EnableEvents = True

'Este código acrescenta valores para a celula estado SP

Static valorcel33 As Integer

Application.EnableEvents = False

If Target.Address = "$F$37" Then

valorcel33 = Target.Value + valorcel33

If Target.Value = 0 Then valorcel33 = 0

Target.Value = valorcel33

End If

Application.EnableEvents = True

'Este código acrescenta valores para a celula estado SE

Static valorcel34 As Integer

Application.EnableEvents = False

If Target.Address = "$F$38" Then

valorcel34 = Target.Value + valorcel34

If Target.Value = 0 Then valorcel34 = 0

Target.Value = valorcel34

End If

Application.EnableEvents = True

'Este código acrescenta valores para a celula estado TO

Static valorcel35 As Integer

Application.EnableEvents = False

If Target.Address = "$F$39" Then

valorcel35 = Target.Value + valorcel35

If Target.Value = 0 Then valorcel35 = 0

Target.Value = valorcel35

End If

Application.EnableEvents = True

End Sub

Gostaria muito de uma luz para resolver este problema, agradeço muito desde já as respostas que virão e espero que ajude outras pessoas com o mesmo problema.

Obrigado

Edson Luiz Branco · 5 de outubro de 2016

Boa tarde, Laerte

Sua questão é semelhante à uma dúvida que respondi há muito tempo atrás (dezembro de 2001) no extinto GDI da Fórum Access (cuja base hoje está no site de uma empresa - Itlab). Acho até que ainda tenho a planilha que usei naquela época para criar a macro.

Como sua macro é bastante extensa não posso analisá-la agora, à noite tentarei dar uma olhada e procuro em meus arquivos.

Enquanto isso, se quiser ir estudando como foi solucionado, dá uma olhada em como foi construída a macro aqui:

Fórum Acces/Itlab - "Referência p/ a mesma célula"

_________

Em tempo: encontrei a pasta de trabalho Excel que fiz naquela época. Tá meio embolorada e cheia de poeira , mas dá uma olhada:

GDFórumAccess - Referência mesma Célula.xls

LaerteB · 5 de outubro de 2016

Boa tarde, Edson Luiz

Obrigado pela resposta, vou verificar estes links que informou, espero encontrar a solução.

Quando tiver visto lhe informarei aqui se consegui arrumar e colocarei a programação correta para que outros possam tirar como exemplo ou modificá-la para o projeto que estiverem realizando.

Se ainda alguém quiser informar uma maneira mais fácil de uma macro menos extensa, terá toda a minha atenção.

valeu.

____________

Abri os links e estarei analisando-os (ainda sou iniciante preciso assimilar o conteúdo rsrsrs), vou ter que olhar mais no final da noite que terei mais tempo, e quando tiver uma resposta colocarei aqui, quero agradece-lo desde já. Valeu.

LaerteB · 6 de outubro de 2016

Boa Noite, Edson Luiz Branco

Agora a noite estudei os links e a programação e com as planilhas do meu projeto, tirei a programação anterior que eu tinha feito (que era muito extensa), pela a que você indicou (pequena e eficiente) com as alterações das células que precisava.

Funcionou, mas a primeira vez da um erro como se segue:

*******

Erro em tempo de execução '5':
Argumento ou chamada de procedimento inválida

********

E quando clico para depurar informa este trecho em negrito abaixo:

**********

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim Lin As Long, Col As Long
If Not Intersect(Target, Interv) Is Nothing Then

**********

Colocando em redefinir e volto a planilha funciona normal como eu queria, não sei o que pode ter acontecido para aparecer este erro. Não atrapalha esse erro (só incomoda), pois quando redefino ele funciona bem, mesmo salvando e fechando a planilha, mas gostaria de um luz para este erro para o meu aprendizado.

Como tinha falado abaixo incluindo a programação com a minha alteração na minha planilha:

**********

Option Explicit
Public Valores As Variant, Interv As Range

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
   Set Interv = Range("A4:B4:C4:D4:E4:F4:B13:B14:F13:F14:F15:F16:F17:F18:F19:F20:F21:F22:F23:F24:F25:F26:F27:F28:F29:F30:F31:F32:F33:F34:F35:F36:F37:F38:F39")
      If Not Intersect(Target, Interv) Is Nothing Then
     Valores = Interv
   End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim Lin As Long, Col As Long
If Not Intersect(Target, Interv) Is Nothing Then
    If Target.Cells.Count > 1 Then
      MsgBox "Selecione e altere apenas uma célula de cada vez", vbExclamation, "Atenção"
      Exit Sub
    End If
    Lin = Target.Row - Interv.Cells(1, 1).Row + 1
    Col = Target.Column - Interv.Cells(1, 1).Column + 1
      If IsNumeric(Valores(Lin, Col)) And IsNumeric(Target.Value) Then
        Application.EnableEvents = False
          Target.Value = Target.Value + Valores(Lin, Col)
        Application.EnableEvents = True
      End If
End If
End Sub

************

Agradeço muito e aguardo se puder me esclarecer deste erro que não sei o porque ocorre na primeira vez e nas demais não (pode ser que eu fiz algo errado).

Obrigado.

DJunqueira · 6 de outubro de 2016

você tentou montar seu intervalo algo como ("A4:F4;B13:B14;F14:F30") ?

LaerteB · 6 de outubro de 2016

Bom dia, DJunqueira

Agradeço a sua resposta, mas tentei este método acima que citou (não funcionou), continuou com o erro que expus e agora quando redefino após este erro, aparece um novo com o código "1004" e salienta a linha que fiz a alteração que sugeriu, conforme a seguir: Set Interv = Range("A4:F4;B13:B14;F13:F39").

Estou tentando ver o que pode ter ocorrido este erro, mas como sou novato estou com dificuldades nesta análise, aguardarei mais sugestões.

Obrigado pela resposta e a sua sugestão, é muito importante para mim, pois vou aprendendo cada vez mais, valeu.

Edson Luiz Branco · 6 de outubro de 2016

No intervalo que o Domingos montou, apenas troque o ponto-e-vírgula por vírgula:

Set Interv = Range("A4:F4,B13:B14,F13:F39")

LaerteB · 6 de outubro de 2016

Bom dia, Edson Luiz Branco

Então eu refiz o que você citou acima, troquei o ; por , agora está dando outro erro na linha (depois da sequencia digitada da A4 até F4 normal, quando digito na célula B13 da esse erro) como se segue abaixo:

**********

Erro em tempo de execução '9':
Subscrito fora do intervalo

A linha que aparece em amarelo depois de clicar em depurar:

If IsNumeric(Valores(Lin, Col)) And IsNumeric(Target.Value) Then

**********

Edson Luiz Branco · 6 de outubro de 2016

Laerte, aqui funcionou normal, mesmo com as modificações.

Para diagnosticar o que possa estar acontecendo acredito que somente analisando seu arquivo.

LaerteB · 6 de outubro de 2016

Boa tarde, Edson Luiz Branco

Ok estou enviando o link do arquivo, para uma melhor análise.

Deixei sem valores nas planilhas.

Espero que isso ajude.

https://www.sendspace.com/file/pu8knj

Edson Luiz Branco · 6 de outubro de 2016

Ok, Laerte, vou verificar hoje à noite, mas à princípio já imagino o que seja: no arquivo original usei uma array (Variant) de duas dimensões (variável Valores) e estava adequado àquela situação, já que o requisito da época não incluía intervalos não-contíguos/não adjacentes o que já não acontece em seu caso, visto que o range A4:F4,B13:B14,F13:F39 é composto por três áreas distintas não contíguas. Então as variáveis Lin, Col acabam extrapolando os subscritos da matriz "Valores" e a rotina fica comprometida, funcionando apenas no primeiro Range (A4:F4).

Fique tranquilo, pois tem solução. Só não poderei fazer isso agora, ok?

LaerteB · 6 de outubro de 2016

OI, Edson Luiz Branco, OK.

Vou aguardar a sua análise, fiquei mais tranquilo agora que você disse que tem solução, ufa..

Agradeço muito a sua disposição em ajudar, com isso eu consigo assimilar mais conteúdos no Excel e nas macros.

Eu sou autodidata, com isso tenho que ler muito livros e conteúdos diversos para realizar os projetos.

Errando que se aprende e contribuindo/ajudando que fazemos o nosso melhor para o próximo.

Valeu, até mais.

Edson Luiz Branco · 7 de outubro de 2016

@LaerteB , dá uma experimentada assim. Ficou um pouco mais enxuto, pois o código força você a trabalhar apenas com uma célula de cada vez naqueles intervalos. Testa e dá retorno, ok?

Option Explicit
Public Valor As Variant, Interv As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
   Set Interv = Range("A4:F4,B13:B14,F13:F39")
   If Not Intersect(Target, Interv) Is Nothing Then
     If Target.Cells.Count > 1 Then Target(1, 1).Select
     Valor = Target(1, 1).Value
   End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
  If Not Intersect(Target, Interv) Is Nothing Then
      If IsNumeric(Valor) And IsNumeric(Target.Value) Then
        Application.EnableEvents = False
          Target.Value = Target.Value + Valor
        Application.EnableEvents = True
      End If
  End If
End Sub

LaerteB · 7 de outubro de 2016

Bom dia, Edson Luiz Branco.

Primeiramente obrigado, mas está dando erro '5', efetuei as alterações que você informou acima, só que está ocorrendo como se segue:

*****

erro em tempo de execução '5':
Argumento ou chamada de procedimento inválida

quando clico em depurar informa em amarelo a linha como se segue:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Not Intersect(Target, Interv) Is Nothing Then
      If IsNumeric(Valor) And IsNumeric(Target.Value) Then
        Application.EnableEvents = False
          Target.Value = Target.Value + Valor
        Application.EnableEvents = True
      End If
End If
End Sub

****

E quando clico em redefinir, na planilha consigo inserir os dados sem esse erro, mesmo salvando e reabrindo o arquivo fica normal, somente na primeira vez que é utilizado dá esse erro acima.

DJunqueira · 7 de outubro de 2016

@LaerteBeu apliquei esse código numa planilha e não deu erro algum...

Soma automática na célula.zip

Edson Luiz Branco · 7 de outubro de 2016

Bom dia, Laerte.

Isso ocorreu porque você usou o mesmo código em cada uma de suas planilhas, não é? Eu não tinha me dado conta que todas as suas plans são idênticas, uma prá cada mês e que você queria replicar o código em cada uma delas... Na verdade nem circulei entre elas, fiquei só na primeira e deci a lenha, hehehe. Desculpa aí, foi mal.

De fato, se simplesmente copiar/colar o mesmo código em todas, ocorrerá um conflito na hora de definir o Range Interv. Para corrigir isso, você deveria qualificar à qual planilha o intervalo estaria se referindo. Para isso, daria prá usar:

Set Interv = Me.Range("A4:F4,B13:B14,F13:F39")

Maaaassss permita-me sugerir outra abordagem nesse caso. Para simplificar ainda mais, ao invés de repetir o mesmo código para cada planilha, você poderia inserir os códigos apenas no módulo do workbook ("EstaPasta_de_trabalho"), com pequenas modificações para prevenir que o código seja executado em outras planilhas que não aquelas nomeadas "mes 00-0000".

Sugeriria assim (também anexei para sua apreciação):

Option Explicit
Option Compare Text
Private Valor As Variant, Interv As Range

Private Sub Workbook_Open()
  Valor = ActiveCell.Value
  Set Interv = ActiveSheet.Range("A4:F4,B13:B14,F13:F39")
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
  Valor = ActiveCell.Value
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
   If Not (Sh.Name Like "m[eê]s ##-####") Then Exit Sub
   Set Interv = Sh.Range("A4:F4,B13:B14,F13:F39")
   If Not Intersect(Target, Interv) Is Nothing Then
     If Target.Cells.Count > 1 Then Target(1, 1).Select
     Valor = Target(1, 1).Value
   End If
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  If Not (Sh.Name Like "m[eê]s ##-####") Then Exit Sub
  If Not Intersect(Target, Interv) Is Nothing Then
      If IsNumeric(Valor) And IsNumeric(Target.Value) Then
        Application.EnableEvents = False
          Target.Value = Target.Value + Valor
        Application.EnableEvents = True
      End If
  End If
End Sub

Planilha media respostas ano 2016- teste 02.rar

LaerteB · 7 de outubro de 2016

Boa tarde, Edson Luiz Branco e DJunqueira

Primeiro DJunqueira obrigado pelas respostas, mas não obtive sucesso no seu modelo, até pelo fato do Edson estar no caminho certo, pois como ele mesmo citou acima não é para só uma planilha e sim para várias idênticas; por essa razão pode ter ocorrido o erro.

Agora Edson, o seu 1ª modelo com o a acréscimo "Me." para qualificar cada planilha independentemente, funcionou normal da planilha 01-2016 até a 03-2016 na 04-2016 da o seguinte erro (que depois de depurado e redefinido funciona normal somente na planilha selecionada):

********

erro em tempo de execução '5':
Argumento ou chamada de procedimento inválida

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Not Intersect(Target, Interv) Is Nothing Then
      If IsNumeric(Valor) And IsNumeric(Target.Value) Then
        Application.EnableEvents = False
          Target.Value = Target.Value + Valor
        Application.EnableEvents = True
      End If
End If
End Sub

Erro na linha em vermelho acima

**********

Bem no seu segundo modelo começa a dar o erro a partir da planilha 03-2016 em diante e não mesmo redefinindo não funciona legal, a seguir o erro:

*********

erro em tempo de execução '1004'
O método 'Intersect' do objeto '_Global' falhou

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not (Sh.Name Like "m[eê]s ##-####") Then Exit Sub
If Not Intersect(Target, Interv) Is Nothing Then
      If IsNumeric(Valor) And IsNumeric(Target.Value) Then
        Application.EnableEvents = False
          Target.Value = Target.Value + Valor
        Application.EnableEvents = True
      End If
End If

End Sub

Erro na linha em vermelho acima

********

Eu tentei verificar se tinha alguma coisa errada e não consegui achar, será que como uso o Excel 2010 pode ser que algo não funcione com estes procedimentos?? bem só uma reflexão de iniciante rsrsrs..

Ou eu tinha que acrescentar algo após essa linha vermelha acima???

Edson Luiz Branco · 7 de outubro de 2016

você baixou o último anexo ou já alterou sua pasta e copiou e colou o código? Acabei de testar aqui a que te enviei, da 01 até a 12 e está funcionando...

Quanto ao uso da palavra-chave "Me" eu não testei todas, até mesmo porque já tinha deletado a pasta e achei desnecessário depurar pois a outra metodologia é mais eficiente.

LaerteB · 7 de outubro de 2016

Edson, eu baixei e deixei como estava, dai na planilha 04-2016 em diante começou o segundo erro acima que citei.. bem como tinha alterado para a 1ª opção o arquivo, então deletei este arquivo e abri novamente do arquivo que baixei em rar.

Tentando digitar os valores a partir do mes 04-2016 dá-se o erro acima descrito, e não alterei nada o que você tinha feito.

Eu começo a digitar a partir da célula A4 em sequencia, a segunda célula que dá esse erro...

---------------------

Eu testei novamente digitando em células diferentes a A4 e B4, e não ocorre este erro, somente quando digito no A4 e em seguida B4, dai ocorre; queria lhe informar isso quem sabe se pode ser essa sequencia..

Edson Luiz Branco · 10 de outubro de 2016

Entendi.

Vê agora.

Planilha media respostas ano 2016- teste 02.rar

LaerteB · 10 de outubro de 2016

Bom dia Edson.

Nossa agora ficou excelente, não dá mais nenhum erro, o código em macro serviu como uma luva obrigado.

Vou estudar mais o seu código para ver o que estava dando esses erros.

Quero muito agradecê-lo pela sua ajuda, valeu mesmo.

Agora como tinha informado estarei disponibilizando abaixo o código da macro, para que outras pessoas possam utilizá-las (modificando-as de acordo com o seu projeto) caso necessário:

*************

Option Explicit
Option Compare Text
Private Valor As Variant, Interv As Range

Private Sub Workbook_Open()
  DefineRange ActiveSheet
  Valor = ActiveCell.Value
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
  DefineRange Sh
  Valor = ActiveCell.Value
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
   If Not (Sh.Name Like "m[eê]s ##-####") Then Exit Sub
   DefineRange Sh
   If Not Intersect(Target, Interv) Is Nothing Then
     If Target.Cells.Count > 1 Then Target(1, 1).Select
     Valor = Target(1, 1).Value
   End If
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  If Not (Sh.Name Like "m[eê]s ##-####") Then Exit Sub
  DefineRange Sh
  If Not Intersect(Target, Interv) Is Nothing Then
      If IsNumeric(Valor) And IsNumeric(Target.Value) Then
        Application.EnableEvents = False
          Target.Value = Target.Value + Valor
        Application.EnableEvents = True
      End If
  End If
End Sub

Sub DefineRange(ws As Worksheet)
  Set Interv = ws.Range("A4:F4,B13:B14,F13:F39")
End Sub

Edson Luiz Branco · 10 de outubro de 2016

Valeu, Laerte. Que bom que o código lhe foi útil.

Quanto ao erro, ele acontecia quando você pulava para outra planilha e já ia digitando numa célula sem selecioná-la, posto que já estava originalmente selecionada. Então o evento SheetSelectionChange não ocorria resultando que o range Interv ainda estaria se referindo à planilha anterior. Por isso "cerquei" ele capturando-o também através do evento SheetActivate.

Se tiver tempo, edite seu post anterior e recorte a parte do código e use a ferramenta code (< >) para facilitar a leitura do post e deixar o tópico organizado, ok?

Saudações, Edson.