H o l a:
Una mejora sería, verificar cierto rango de celdas para que se ejecute la macro.
Así como la tienes, cualquier modificación a cualquier celda, la macro se ejecuta, lo más conveniente es que se ejecute la macro si solamente modificaste una celda de un rango definido.
Te anexo un ejemplo, si una celda del rango F5:G19" o del rango "L5:M19" es modificada, entonces que se ejecute la macro.
Modifica los rangos a lo que es conveniente para tu caso.
También agregué esta instrucción:
Application.EnableEvents = False
Eso significa que mientras se esté ejecutando la macro, los eventos se desactivarán. Te lo comento, ya que en tu macro tienes esto:
Range("F5:G19").Replace What:=" EUR", Replacement:=""
Lo que estás haciendo es modificar el contenido de una celda por "", y esto, nuevamente está modificando una celda, y esto está haciendo que la macro se ejecute nuevamente, entrando en un loop; que puede hacer que excel se bloqueé.
La macro actualizada:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("F5:G19, L5:M19")) Is Nothing Then
' Estadillo unicaja
'Desactiva los eventos
Application.EnableEvents = False
' Para quitar el espacio+letras
Range("F5:G19").Replace What:=" EUR", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
' Alinear a la izquierda
Range("E6:E19").HorizontalAlignment = xlLeft
' Convertir a Numero
Range("F5:G19").Select
For Each cd In Selection
On Error Resume Next
'si Val devuelve 0 es porque se trata de celdas con texto, no números guardados como texto
If Val(cd) <> 0 Then
cd.Value = cd.Value * 1
End If
Next
' Ingresar filas vacias
Range("B6:G19").Select
Selection.Insert Shift:=xlDown
' Eliminar filas vacias
Range("B20:G40").Cells.SpecialCells(xlCellTypeBlanks).Delete xlUp
' ESTADILLO ING DIRECT
' Para quitar el espacio+letras
Range("L5:M19").Replace What:=" EUR", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
' Alinear a la izquierda
Range("K6:K19").HorizontalAlignment = xlLeft
' Convertir a Numero
Range("L5:M19").Select
For Each cd In Selection
On Error Resume Next
'si Val devuelve 0 es porque se trata de celdas con texto, no números guardados como texto
If Val(cd) <> 0 Then
cd.Value = cd.Value * 1
End If
Next
' Ingresar filas vacias
Range("I6:M19").Select
Selection.Insert Shift:=xlDown
' Eliminar filas vacias
Range("I20:M40").Cells.SpecialCells(xlCellTypeBlanks).Delete xlUp
'
'Activa los eventos
Application.EnableEvents = True
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("F5:G19, L5:M19")) Is Nothing Then
' Estadillo unicaja
'Desactiva los eventos
Application.EnableEvents = False
' Para quitar el espacio+letras
Range("F5:G19").Replace What:=" EUR", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
' Alinear a la izquierda
Range("E6:E19").HorizontalAlignment = xlLeft
' Convertir a Numero
Range("F5:G19").Select
For Each cd In Selection
On Error Resume Next
'si Val devuelve 0 es porque se trata de celdas con texto, no números guardados como texto
If Val(cd) <> 0 Then
cd.Value = cd.Value * 1
End If
Next
' Ingresar filas vacias
Range("B6:G19").Select
Selection.Insert Shift:=xlDown
' Eliminar filas vacias
Range("B20:G40").Cells.SpecialCells(xlCellTypeBlanks).Delete xlUp
' ESTADILLO ING DIRECT
' Para quitar el espacio+letras
Range("L5:M19").Replace What:=" EUR", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
' Alinear a la izquierda
Range("K6:K19").HorizontalAlignment = xlLeft
' Convertir a Numero
Range("L5:M19").Select
For Each cd In Selection
On Error Resume Next
'si Val devuelve 0 es porque se trata de celdas con texto, no números guardados como texto
If Val(cd) <> 0 Then
cd.Value = cd.Value * 1
End If
Next
' Ingresar filas vacias
Range("I6:M19").Select
Selection.Insert Shift:=xlDown
' Eliminar filas vacias
Range("I20:M40").Cells.SpecialCells(xlCellTypeBlanks).Delete xlUp
'
'Activa los eventos
Application.EnableEvents = True
End If
End Sub
':)
'S aludos. D a n t e A m o r . R ecuerda valorar la respuesta. G racias
':)