Macro roda algumas vezes e pára

Question

Olá pessoal,

Tenho uma macro que é acionada quando seleciono algum valor em uma célula com validação de dados, e acontece que a macro roda algumas vezes e para, sendo necessário eu rodar ela pelo VBA para ela voltar a funcionar.

minha dúvida é se tem algo na macro que está causando isto, visto que algumas vezes ela funciona por 5x,outras 10x outras 20x e do nada pára. No Último teste rodou por quase 30x e parou.

Posto aqui o código para análise. Desde já agradeço a todos.

Private Sub Worksheet_Change(ByVal Target As Range)

  Dim interseccao As Range 

  Set interseccao = Intersect(Target, Range("K3")) 

  If interseccao Is Nothing = False Then 

  Call Retorna\_Cores 

  End If 

End Sub

Public Pavimento As String

Public R, G, B As Integer

Public servico As Range

Public pav As String

Public Sub Retorna_Cores()

Application.Calculation = xlCalculationManual

Application.ScreenUpdating = False

Application.EnableEvents = False

Planilha8.Select

Shp_Sem_Preenchimento

' buscavalor Macro

Planilha7.Select 

Range("F1").Select ' seleciona a primeira linha da coluna a ser analisada 

Do Until ActiveCell = fim ' executa a macro até encontrar a palavra fim no fim da coluna a ser analisada

If Planilha8.Range("K3").Value <> ActiveCell.Offset(0, 0).Value Then 

ActiveCell.Offset(1, 0).Select 'desce uma linha 

Else 

ActiveCell.Offset(1, 0).Select 'desce uma linha 

Pavimento = ActiveCell.Offset(0, 2).Value 

R = ActiveCell.Offset(0, -4).Value 

G = ActiveCell.Offset(0, -3).Value 

B = ActiveCell.Offset(0, -2).Value 

'Se encontrar célula em branco para a macro

If ActiveCell.Offset(0, 2).Value = "" Then

Planilha8.Select

Range("K3").Select

Exit Sub

Else 

Call Pinta\_Shapes 

If ActiveCell = Planilha8.Range("K3").Value Then    'faz a análise lógica 

ElseIf ActiveCell = 6 Then 'faz a análise lógica 

Planilha7.Select 

End If 

End If 

End If

Loop

Planilha8.Select

Range("K3").Select ' retorna para o inicio da coluna

Application.Calculation = xlCalculationAutomatic 

Application.ScreenUpdating = True 

Application.EnableEvents = True 

End Sub

Public Sub Pinta_Shapes() 'Macro para selecionar o shape e pintá-lo

Dim a As String

Planilha8.Select 

ActiveSheet.Shapes(Pavimento).Select 

ActiveSheet.Shapes(Pavimento).Fill.ForeColor.RGB = RGB(R, G, B) 

Planilha7.Activate 

End Sub

Public Sub Shp_Sem_Preenchimento() 'Macro para selecionar o shape e deixá-lo sem preenchimento

Planilha8.Select 

Planilha8.Shapes.SelectAll 

Selection.ShapeRange.Fill.Visible = msoFalse 

End Sub

Answer 1

Esta resposta foi traduzida automaticamente. Como resultado, pode haver erros gramaticais ou palavras estranhas.

Olá, Abel de Castilhos dos Santos

Bem-vindo à Comunidade Microsoft.

Para questões técnicas como Macro ou VBA, se você ainda não recebeu uma solução na Comunidade Microsoft, sugiro que você também publique sua pergunta para a Comunidade Microsoft Power BI

office-excel-itpro - Microsoft Q &A (Somente inglês disponível, você pode usar a ferramenta de tradução para visualizar artigos)

Os membros aqui são muito bons em Macro e VBA. Mas é claro, você pode esperar por uma solução neste post também.

Espero que seu problema possa ser resolvido em breve.

Atenciosamente

Yuhao Li| Especialista em Suporte à Comunidade da Microsoft