Macro lenta en la ejecución calculando celdas
Tengo esto en la hoja :
Private Sub Worksheet_Activate()
ActiveSheet.ScrollArea = "A1:Q6000"
Call Celdas_oculta
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
If Target.Column = 4 Then
If Cells(Target.Row, "B") = "" Then
Cells(Target.Row, "B") = Date
End If
End If
If Not Intersect(Target, Range(" A10:E60000")) Is Nothing Then Target.Value = UCase(Target.Value)
End Sub
Y si cambio algo en la celda "D" se paraliza un tiempo diciendo:
"Calculando celdas : 100%"
2 Respuestas
Observa que el evento Change (cambio) se ejecuta cuando realizas un cambio en col D modificando datos en col B ... y allí entra entonces a ejecutarse nuevamente el evento porque se trata de un cambio en el rango A:E... y entra en un bucle.
Hay que rearmar esa rutina.
Pero además al activarse la hoja se ejecuta otra que quizás también afecte o 'cambie' celdas... mejor me escribes aquí todo el código de la hoja o me envias el libro a mi correo y te corrijo las macros.
Sdos
Elsa
Te he mandado el archivo
Gracias Elsa
Recibido, en un rato te lo preparo. Sdos!
gracias
Así debiera quedar la macro:
Private Sub Worksheet_Change(ByVal Target As Range)
'x Elsamatilde
'controla cambios en rango A:E
If Not Intersect(Target, Range(" A10:E60000")) Is Nothing Then
'si solo se limpian celdas en el rango no ejecuta el resto
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
'para que no vuelva a ejecutar al pasar a mayúsc
Application.EnableEvents = False
'pasa a mayúsc
Target.Value = UCase(Target.Value)
'si el cambio fue en col D, además coloca fecha en B
If Target.Column = 4 Then
If Cells(Target.Row, "B") = "" Then Cells(Target.Row, "B") = Date
End If
'vuelve a habilitar los eventos
Application.EnableEvents = True
End If
End SubObserva que además le agregué opción de que no ejecute si se seleccionan varias celdas (quizás para borrarlas) o se borra 1 sola, sinó dará error.
Probala y comentame.
Sdos!
Te anexo la macro actualizada
Private Sub Worksheet_Activate()
ActiveSheet.ScrollArea = "A1:Q6000"
Call Celdas_oculta
End Sub
'
Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
If Not Intersect(Target, Range(" A10:E60000")) Is Nothing Then
For Each c In Target
Application.EnableEvents = False
If c.Column = 4 Then
If Cells(c.Row, "B") = "" Then
Cells(c.Row, "B") = Date
End If
End If
c.Value = UCase(c.Value)
Application.EnableEvents = True
Next
End If
End SubSaludos.Dante Amor
Gracias Dante, fabuloso
Un saludo
Este código no es mío, así no programo.
If Not Intersect(Target, Range(" A10:E60000")) Is Nothing Then Target.Value = UCase(Target.Value)
End Sub
Notificaciones:
