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

2 Respuestas

2.215.690 pts. REGALA(TE) manuales Excel. Aprovecha el ciber-mes de...

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 Sub

Observa 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!

4.703.150 pts. Sancho, si los perros ladran ...

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 Sub

Saludos.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:

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas