Excel Excel travando ao executar macro VBA

[hudsonsaldanha]

Ola pessoal tudo bom!!!!

 

Estou com um problema em minha que acredito ser em minha macro, pois quando abro ela(planilha com a macro) sozinha no pc ela funciona porém fica como se tivesse processando o tempo todo e não da para editar ou usa-la, e se abrir outra planilha ou se outra planilha ja estiver aberta quando eu abro ela(planilha com a macro) ela não roda e as vezes roda parcialmente.

Espero que possam me ajudar!

segue abaixo o código:

Sub periodopregão()

If Hour(Now) > 18 Then
Application.OnTime Now + TimeValue("08:00:00"), "periodopregão"
End If

If Hour(Now) < 8 Then
Application.OnTime Now + TimeValue("00:00:30"), "periodopregão"
End If

If Hour(Now) > 9 And Hour(Now) < 18 Then
Application.OnTime Now + TimeValue("00:00:30"), "start"
End If

End Sub


Sub start()
Workbooks("mont carlo_wiener(1).xlsm").Worksheets("Planilha2").Activate
If Planilha2.Range("g3").Value = "Normal" Then
Application.OnTime Now + TimeValue("00:00:01"), "cron"
Application.OnTime Now + TimeValue("00:00:30"), "inserçãodados"
Application.OnTime Now + TimeValue("00:00:01"), "inserçãodados2"
End If
If Planilha2.Range("g3").Value <> "Normal" Then
periodopregão
End If
End Sub


Sub inserçãodados()

If Planilha2.Range("b3").Value <> Planilha2.Range("b4").Value Then

Planilha2.Range("b4:g141").Value = Planilha2.Range("b3:g140").Value

Planilha2.Range("c3").Value = Planilha2.Range("f4").Value
Planilha2.Range("d3").Value = Planilha2.Range("f4").Value
Planilha2.Range("e3").Value = Planilha2.Range("f4").Value
Application.OnTime Now + TimeValue("00:00:30"), "inserçãodados"
End If

End Sub


Sub inserçãodados2()

If Planilha2.Range("b3").Value <> Planilha2.Range("b4").Value Then
Planilha2.Range("AL4:AN141").Value = Planilha2.Range("AL3:AN140").Value
Application.OnTime Now + TimeValue("00:00:01"), "inserçãodados2"
End If

End Sub


Sub cron()

If Planilha2.Range("g3").Value = "Normal" Then
Planilha2.Range("b3").Value = Now
Application.OnTime Now + TimeValue("00:00:01"), "cron"
Else
periodopregão

End If
End Sub

 

[Midori]

@hudsonsaldanha Eu acho que você está fazendo muitas chamadas a função Ontime. Isso pode ser um problema na hora da identificar o erro. Tente fazer apenas uma chamada e se for necessário fazer outra interrompa a anterior.

 

Segue uma sugestão,

 

Dim WkSheet     As Worksheet
Dim Contador    As Integer
Dim Continua    As Boolean

Sub Start()
    Dim WkBook As Workbook
    
    Set WkBook = Workbooks("mont carlo_wiener(1).xlsm")
    Set WkSheet = WkBook.Worksheet("Planilha2")
    
    If WkSheet.Range("G3") = "Normal" Then
        Call Tempo
    Else
        Call PeriodoPregão
    End If
End Sub

Sub Tempo()
    Contador = Contador + 1
    
    With WkSheet
        If .Range("G3") = "Normal" Then .Range("G3") = Now
        
        If Contador >= 30 Then
            If .Range("B3") <> .Range("B4") Then
                'inserçãodados
                .Range("B4:G141") = .Range("B3:G140")
                .Range("C3:E3") = .Range("F4")
            End If
            Contador = 1
        End If
            
        'inserçãodados2
        .Range("AL4:AN141") = .Range("AL3:AN140")
    End With
    
    Application.OnTime Now + TimeValue("00:00:01"), "Tempo"
End Sub

Sub PeriodoPregão()
    On Error GoTo FIM
    
    If Hour(Now) > 9 And Hour(Now) < 18 Then
        Continua = False
    Else
        Continua = True
    End If
    
    Application.OnTime Now + TimeValue("00:00:30"), "PeriodoPregão", , Continua
    
FIM: If Err.Number = 1004 Or Continua = False Then Call Start
End Sub

 

Na sub tempo dá para executar os comandos de insersão1 e 2 com apenas um Time a cada 1 segundo e no caso do comando para 30 segundos é só usar uma variável como contador.

 

A variável boolean Continua quando é igual a False vai interromper o Time de PeridoPregão e chamar a Sub Start

[hudsonsaldanha]

@Midori Funcionou perfeitamente, resolveu meu problema muito obrigado!!!

Não sabia que não dava pra usar dois comando On timer ao mesmo tempo. Uma duvida, o Excel fica processando o cod. a cada segundo então se eu tentar editar uma célula ou altera qualquer coisa na planilha ele para a contagem... e assim mesmo?e normal?

[Midori]

@hudsonsaldanha  Quando você edita uma célula na mesma instância durante a execução de OnTime a contagem é interrompida até terminar a edição.

 

Para evitar isso você pode abrir outra instância do Excel (clique com o botão direto no ícone do aplicativo e pressionando Alt abra o Excel). Assim a instância da planilha de OnTime ficará independente e não vai parar quando editar na outra.

[hudsonsaldanha]

@Midori Perfeito, isso resolve porque assim eu crio uma planilha com banco de dados e processamento e não outro so exibo os graficos! Por acaso você faz programação em Python se sim, entre com contato comigo tenho um trabalho pra ser feito.

[hudsonsaldanha]

Em 15/08/2020 às 19:07, Midori disse:

@hudsonsaldanha  Quando você edita uma célula na mesma instância durante a execução de OnTime a contagem é interrompida até terminar a edição.

 

Para evitar isso você pode abrir outra instância do Excel (clique com o botão direto no ícone do aplicativo e pressionando Alt abra o Excel). Assim a instância da planilha de OnTime ficará independente e não vai parar quando editar na outra.

Agora estou com outro problema, a "Sub tempo()" só esta rodando se eu estiver com a planilha2 (onde ela executa as operações) ativa, se eu estiver em outra aba ela não roda e por consequência não atualiza os gráficos.

[Midori]

1 hora atrás, hudsonsaldanha disse:

Agora estou com outro problema, a "Sub tempo()" só esta rodando se eu estiver com a planilha2 (onde ela executa as operações) ativa, se eu estiver em outra aba ela não roda e por consequência não atualiza os gráficos.

Essa sub deve ser chamada pela Start, veja se isso está sendo feito corretamente.

 

Quando a sub Tempo está em execução não vejo motivo para parar apenas selecionando outra aba.

 

Para entender melhor o problema teria que verificar a planilha.

[hudsonsaldanha]

22 minutos atrás, Midori disse:

Essa sub deve ser chamada pela Start, veja se isso está sendo feito corretamente.

 

Quando a sub Tempo está em execução não vejo motivo para parar apenas selecionando outra aba.

 

Para entender melhor o problema teria que verificar a planilha.

Estou iniciando pelo "start" mesmo, não estou conseguindo encontrar o problema. quando seguro o "F8" a macro roda normal, quando solto ela para. E possível que os gráficos interfere no funcionamento da macro? tenho 12 gráficos na tela!

Se possível entra em contato comigo que te mando a planilha. [email protected]

[Isaque94]

Olá pessoal, Tudo bem resolvi postar aqui pois é o mesmo problema do @hudsonsaldanha, achei desnecessário abrir outro tópico para resolver a mesma situação, perdoem-me se estiver errado.

 

O meu caso o Excel também fica só processando e se eu tentar editar ou adicionar alguma informação dá erro no Excel, como não entendo muito de VBA não sei o que devo melhorar para resolver a situação, se puderem dêem uma olhada pra ver se encontram o problema:

 

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$B$5" Then
    If Not IsEmpty(Target) Then
      If IsNumeric(Target.Value) Then
        Target.Offset(-1, 0) = Target.Offset(-1, 0) + Target.Value
      Else
        MsgBox "Somente valores numéricos são permitidos!", vbCritical, "Tipos incompatíveis"
      End If
    End If
      Target.ClearContents
  End If
    If Target.Address = "$B$6" Then
    If Not IsEmpty(Target) Then
      If IsNumeric(Target.Value) Then
        Target.Offset(-2, 0) = Target.Offset(-2, 0) - Target.Value
      Else
        MsgBox "Somente valores numéricos são permitidos!", vbCritical, "Tipos incompatíveis"
      End If
    End If
      Target.ClearContents
      Target.Select
  End If
  If Target.Address = "$E$5" Then
    If Not IsEmpty(Target) Then
      If IsNumeric(Target.Value) Then
        Target.Offset(-1, 0) = Target.Offset(-1, 0) + Target.Value
      Else
        MsgBox "Somente valores numéricos são permitidos!", vbCritical, "Tipos incompatíveis"
      End If
    End If
      Target.ClearContents
  End If
    If Target.Address = "$E$6" Then
    If Not IsEmpty(Target) Then
      If IsNumeric(Target.Value) Then
        Target.Offset(-2, 0) = Target.Offset(-2, 0) - Target.Value
      Else
        MsgBox "Somente valores numéricos são permitidos!", vbCritical, "Tipos incompatíveis"
      End If
    End If
      Target.ClearContents
      Target.Select
  End If
  If Target.Address = "$B$11" Then
    If Not IsEmpty(Target) Then
      If IsNumeric(Target.Value) Then
        Target.Offset(-1, 0) = Target.Offset(-1, 0) + Target.Value
      Else
        MsgBox "Somente valores numéricos são permitidos!", vbCritical, "Tipos incompatíveis"
      End If
    End If
      Target.ClearContents
  End If
    If Target.Address = "$B$12" Then
    If Not IsEmpty(Target) Then
      If IsNumeric(Target.Value) Then
        Target.Offset(-2, 0) = Target.Offset(-2, 0) - Target.Value
      Else
        MsgBox "Somente valores numéricos são permitidos!", vbCritical, "Tipos incompatíveis"
      End If
    End If
      Target.ClearContents
      Target.Select
  End If
  If Target.Address = "$E$11" Then
    If Not IsEmpty(Target) Then
      If IsNumeric(Target.Value) Then
        Target.Offset(-1, 0) = Target.Offset(-1, 0) + Target.Value
      Else
        MsgBox "Somente valores numéricos são permitidos!", vbCritical, "Tipos incompatíveis"
      End If
    End If
      Target.ClearContents
  End If
    If Target.Address = "$E$12" Then
    If Not IsEmpty(Target) Then
      If IsNumeric(Target.Value) Then
        Target.Offset(-2, 0) = Target.Offset(-2, 0) - Target.Value
      Else
        MsgBox "Somente valores numéricos são permitidos!", vbCritical, "Tipos incompatíveis"
      End If
    End If
      Target.ClearContents
      Target.Select
  End If
  If Target.Address = "$B$17" Then
    If Not IsEmpty(Target) Then
      If IsNumeric(Target.Value) Then
        Target.Offset(-1, 0) = Target.Offset(-1, 0) + Target.Value
      Else
        MsgBox "Somente valores numéricos são permitidos!", vbCritical, "Tipos incompatíveis"
      End If
    End If
      Target.ClearContents
  End If
    If Target.Address = "$B$18" Then
    If Not IsEmpty(Target) Then
      If IsNumeric(Target.Value) Then
        Target.Offset(-2, 0) = Target.Offset(-2, 0) - Target.Value
      Else
        MsgBox "Somente valores numéricos são permitidos!", vbCritical, "Tipos incompatíveis"
      End If
    End If
      Target.ClearContents
      Target.Select
  End If
  If Target.Address = "$E$17" Then
    If Not IsEmpty(Target) Then
      If IsNumeric(Target.Value) Then
        Target.Offset(-1, 0) = Target.Offset(-1, 0) + Target.Value
      Else
        MsgBox "Somente valores numéricos são permitidos!", vbCritical, "Tipos incompatíveis"
      End If
    End If
      Target.ClearContents
  End If
    If Target.Address = "$E$18" Then
    If Not IsEmpty(Target) Then
      If IsNumeric(Target.Value) Then
        Target.Offset(-2, 0) = Target.Offset(-2, 0) - Target.Value
      Else
        MsgBox "Somente valores numéricos são permitidos!", vbCritical, "Tipos incompatíveis"
      End If
    End If
      Target.ClearContents
      Target.Select
  End If
  If Target.Address = "$B$23" Then
    If Not IsEmpty(Target) Then
      If IsNumeric(Target.Value) Then
        Target.Offset(-1, 0) = Target.Offset(-1, 0) + Target.Value
      Else
        MsgBox "Somente valores numéricos são permitidos!", vbCritical, "Tipos incompatíveis"
      End If
    End If
      Target.ClearContents
  End If
    If Target.Address = "$B$24" Then
    If Not IsEmpty(Target) Then
      If IsNumeric(Target.Value) Then
        Target.Offset(-2, 0) = Target.Offset(-2, 0) - Target.Value
      Else
        MsgBox "Somente valores numéricos são permitidos!", vbCritical, "Tipos incompatíveis"
      End If
    End If
      Target.ClearContents
      Target.Select
  End If
  If Target.Address = "$E$23" Then
    If Not IsEmpty(Target) Then
      If IsNumeric(Target.Value) Then
        Target.Offset(-1, 0) = Target.Offset(-1, 0) + Target.Value
      Else
        MsgBox "Somente valores numéricos são permitidos!", vbCritical, "Tipos incompatíveis"
      End If
    End If
      Target.ClearContents
  End If
    If Target.Address = "$E$24" Then
    If Not IsEmpty(Target) Then
      If IsNumeric(Target.Value) Then
        Target.Offset(-2, 0) = Target.Offset(-2, 0) - Target.Value
      Else
        MsgBox "Somente valores numéricos são permitidos!", vbCritical, "Tipos incompatíveis"
      End If
    End If
      Target.ClearContents
      Target.Select
  End If
  If Target.Address = "$B$29" Then
    If Not IsEmpty(Target) Then
      If IsNumeric(Target.Value) Then
        Target.Offset(-1, 0) = Target.Offset(-1, 0) + Target.Value
      Else
        MsgBox "Somente valores numéricos são permitidos!", vbCritical, "Tipos incompatíveis"
      End If
    End If
      Target.ClearContents
  End If
    If Target.Address = "$B$30" Then
    If Not IsEmpty(Target) Then
      If IsNumeric(Target.Value) Then
        Target.Offset(-2, 0) = Target.Offset(-2, 0) - Target.Value
      Else
        MsgBox "Somente valores numéricos são permitidos!", vbCritical, "Tipos incompatíveis"
      End If
    End If
      Target.ClearContents
      Target.Select
  End If
End Sub
 

É o mesmo código, um para Soma e outro para Subtração, porém repetido para várias Células

Desde Já, Obrigado!

[Midori]

@Isaque94 Tente desabilitar os eventos antes de editar as células com EnableEvents e habilite depois. Se não der certo anexe um modelo da planilha.