Ir ao conteúdo

Posts recomendados

Postado

Boa noite, pessoal!

Estou com problemas de loop infinito com VBA. Eis abaixo o meu código:

-Toda vez que é executado este trecho do código:(Range("E4") = iqtd ou Range("F4") = iqtdluz)
 o evento Change é disparado e fica se chamando indefinidamente.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim cvalor As Currency, svalor As Variant, iqtd As Integer, iqtdluz As Integer
Dim cvalorAux As Currency, ctotalArea As Currency

On Error GoTo trata_erro:


If Target.Address = Range("C4").Address Or Target.Address = Range("C5").Address Or _
   Target.Address = Range("C6").Address Or Target.Address = Range("C7").Address Or _
   Target.Address = Range("C8").Address Or Target.Address = Range("C9").Address Or _
   Target.Address = Range("C10").Address Or Target.Address = Range("C11").Address Or _
   Target.Address = Range("C12").Address Or Target.Address = Range("C13").Address Then
   
   
   'atribui os valores das célula para estas variáveis
   
   cvalor = CCur(Range("C4"))
   svalor = CStr(Range("C4"))
   
   cvalorAux = Right(svalor, 2)
   cvalor = Right(svalor, 2)
   ctotalArea = CCur(Range("C4"))
     
     'inícia o loop que irá incrementar o valor de de 40 em 40 em cada interação
     iqtdluz = 0
     iqtd = 0
        
   If (ctotalArea / 6) <= 6 Then
     Exit Sub
     iqtdluz = 100
     iqtd = 0
   End If
   
    Do While cvalorAux <= cvalor
        cvalorAux = (cvalorAux + 40)
        iqtdluz = iqtdluz + 60
        iqtd = iqtd + 1
     Loop
 
 
 Range("E4") = iqtd
 Range("F4") = iqtdluz
 
   Exit Sub

   'trecho para tratamento de erros
trata_erro:
   
   If Err.Number = 13 Then
      Err.Clear
      MsgBox "Houve um erro. ", "Verifique o valor digitado!!"
      Exit Sub
   End If
    

'End If
 
End Sub

 

  • Solução
Postado

@Angela Leticia experimente inserir o EnableEvents = False no inicio do codigo e no final EnableEvents = True

 

 

Private Sub Worksheet_Change(ByVal Target As Range)

Dim cvalor As Currency, svalor As Variant, iqtd As Integer, iqtdluz As Integer
Dim cvalorAux As Currency, ctotalArea As Currency

On Error GoTo trata_erro:

 
If Target.Address = Range("C4").Address Or Target.Address = Range("C5").Address Or _
   Target.Address = Range("C6").Address Or Target.Address = Range("C7").Address Or _
   Target.Address = Range("C8").Address Or Target.Address = Range("C9").Address Or _
   Target.Address = Range("C10").Address Or Target.Address = Range("C11").Address Or _
   Target.Address = Range("C12").Address Or Target.Address = Range("C13").Address Then
   
   Excel.Application.EnableEvents = False
   
   'atribui os valores das célula para estas variáveis
   
   cvalor = CCur(Range("C4"))
   svalor = CStr(Range("C4"))
   
   cvalorAux = Right(svalor, 2)
   cvalor = Right(svalor, 2)
   ctotalArea = CCur(Range("C4"))
     
     'inícia o loop que irá incrementar o valor de de 40 em 40 em cada interação
     iqtdluz = 0
     iqtd = 0
        
   If (ctotalArea / 6) <= 6 Then
     Exit Sub
     iqtdluz = 100
     iqtd = 0
   End If
   
    Do While cvalorAux <= cvalor
        cvalorAux = (cvalorAux + 40)
        iqtdluz = iqtdluz + 60
        iqtd = iqtd + 1
     Loop
 
 
 Range("E4") = iqtd
 Range("F4") = iqtdluz
 
 Excel.Application.EnableEvents = True
 
   Exit Sub

   'trecho para tratamento de erros
trata_erro:
   
   If Err.Number = 13 Then
      Err.Clear
      MsgBox "Houve um erro. ", "Verifique o valor digitado!!"
       Excel.Application.EnableEvents = True
      Exit Sub
   End If
    

End If
 
End Sub

 

  • Curtir 1

Crie uma conta ou entre para comentar

Você precisa ser um usuário para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...

GRÁTIS: ebook Redes Wi-Fi – 2ª Edição

EBOOK GRÁTIS!

CLIQUE AQUI E BAIXE AGORA MESMO!