1

Tengo un problema con esta macro que con pocos argumentos de reemplazar funciona bien pero al aumentar esta variable se vuelve muy lenta, les agradezco de antemano si me podrían ayudar a optimizar su proceso en excel,

Sub TIPOSENAL2011XTIPOSENAL()
 Set a = Sheets("SEN_SENALIZACION")
 Uf = Range("G" & Rows.Count).End(xlUp).Row
For i = 1 To Uf
 a.Range("G" & i) = Replace(a.Range("G" & i), "SP46-SR30", "SP-46/SR-30")
 a.Range("G" & i) = Replace(a.Range("G" & i), "SP47-SR30", "SP-47/SR-30")
 a.Range("G" & i) = Replace(a.Range("G" & i), "SP48-SR30", "SP-48/SR-30")
 a.Range("G" & i) = Replace(a.Range("G" & i), "SP67-SR30", "SP-67/SR-30")
 a.Range("G" & i) = Replace(a.Range("G" & i), "SR-28 Plaqueta", "SR-28 PLAQUETA")
 a.Range("G" & i) = Replace(a.Range("G" & i), "SRB01-SRB37", "SRB-01/SRB-37")
 a.Range("G" & i) = Replace(a.Range("G" & i), "SI-27vc", "SI-27")
 a.Range("G" & i) = Replace(a.Range("G" & i), "SI26-SR39", "SI-26/SR-39")
Next i
End Sub

2 respuestas 2

2

Esto debería ser casi instantáneo, da igual cuantas filas tengas. No obstante, esto sólo va a funcionar si lo único que contienen tus celdas es lo que has puesto ahí, si lo que está reemplazando es parte de un string con más cosas, esto no funcionaría.

Option Explicit
Sub TIPOSENAL2011XTIPOSENAL()

    'Almacenamos la columna G en un array
    Dim arr As Variant
    With ThisWorkbook.Sheets("SEN_SENALIZACION")
        arr = .Range("G1", .Range("G" & .Rows.Count).End(xlUp)).Value
    End With

    'Para que el diccionario funcione, necesitas la libreria
    'Microsoft Scripting Runtime
    'Se activa en Herramientas-Referencias
    Dim Reemplazos As New Dictionary: Set Reemplazos = CargaReemplazos

    'Hacemos un bucle por el array, ya que está almacenado en memoria
    'y es infinitamente más rápido que procesar celdas de Excel.
    Dim i As Long
    For i = 1 To UBound(arr)
        'En cada iteración comprobamos si el valor que miramos está en el diccionario
        'si lo está, cambiamos dicho valor por el item que contiene esa key.
        If Reemplazos.Exists(arr(i, 1)) Then arr(i, 1) = Reemplazos(arr(i, 1))
    Next i

    'Volcamos el array de vuelta a la hoja
    With ThisWorkbook.Sheets("SEN_SENALIZACION")
        .Range("G1", .Range("G" & .Rows.Count).End(xlUp)).Value = arr
    End With

End Sub
Private Function CargaReemplazos() As Dictionary

    'Creamos un diccionario que tendrá como input la Key
    'y como output el item. Cuando le das la key,
    'te devuelve el item.
    Set CargaReemplazos = New Dictionary
    With CargaReemplazos
        .Add "SP46-SR30", "SP-46/SR-30"
        .Add "SP47-SR30", "SP-47/SR-30"
        .Add "SP48-SR30", "SP-48/SR-30"
        .Add "SP67-SR30", "SP-67/SR-30"
        .Add "SR-28 Plaqueta", "SR-28 PLAQUETA"
        .Add "SRB01-SRB37", "SRB-01/SRB-37"
        .Add "SI-27vc", "SI-27"
        .Add "SI26-SR39", "SI-26/SR-39"
        '... Aquí añade el resto y tantos como quieras
    End With

End Function
2

En tu código lo que estás haciendo es un bucle, y en cada celda de ese rango intentas hacer todos esos reemplazos.

Lo que tienes que hacer es cada reemplazo una única vez por rango, no por celda.

Prueba así:

Sub TIPOSENAL2011XTIPOSENAL()
Application.ScreenUpdating = False
Set a = Sheets("SEN_SENALIZACION")
Uf = Range("G" & Rows.Count).End(xlUp).Row

Dim MiRango As Range
Set MiRango = a.Range("G1:G" & Uf)

MiRango.Replace What:="SP46-SR30", Replacement:="SP-46/SR-30", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula

MiRango.Replace What:="SP47-SR30", Replacement:="SP-47/SR-30", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula

'y así con todo lo que quieras reemplazar

Set MiRango = Nothing
Application.ScreenUpdating = True

End Sub

El código de arriba hará cada reemplazo de golpe en todo el rango de la columna G, cambiando todas las celdas afectadas de golpe. De esa manera, no necesitas bucle.

Pruébalo y nos cuentas.

2
  • 1
    En esta parte de la linea FormulaVersion:=xlReplaceFormula2 me da error de compilacion, solo sigue con el proceso cuando le quito el "2" del final y queda asi FormulaVersion:=xlReplaceFormula Commented el 23 may. 2020 a las 23:47
  • 1
    @BriamRamonRodriguez Me colé, eso es porque el 2 final solamente se reconoce en Excel 2016 o superior, y yo tengo la última y sale por defecto. Si usas un Excel anterior, tienes que quitar ese 2 como has hecho.
    – Esei
    Commented el 24 may. 2020 a las 1:14

Tu Respuesta

By clicking “Publica tu respuesta”, you agree to our terms of service and acknowledge you have read our privacy policy.

¿No es la respuesta que buscas? Examina otras preguntas con la etiqueta o formula tu propia pregunta.