1

Reemplzar valor de column Q con valor de column U, si en column U hay cédula y column R es igual a "NNNNNNNNNNN"

Tengo este código:

Dim Rng As Range, InputRng As Range, ReplaceRng As Range
Set InputRng = ActiveSheet.Range("Q4", Range("Q4").End(xlDown))    
Set a = Range("Q4", Range("Q4").End(xlDown))
Set b = Range("U4", Range("U4").End(xlDown))
Set ReplaceRng = Union(a, b).Select

Range("U2").Select
Application.ScreenUpdating = False
For Each Rng In ReplaceRng.Columns(1).Cells
     Rng.Offset(0, 1).Select
    If Rng.Offset(0, 1).Value <> "" And InputRng.Offset(0, 1).Value = "NNNNNNNNNNN" Then        
        Rng.Replace what:=Rng.Value, replacement:=Rng.Offset(0, 1).Value
    End If
Next
2
  • Bienvenido a SO. Cuando dices si en column U hay cédula a que te refieres? a que haya datos? Y otra cosa. Para hacer esto, no necesitas VBA, una simple formula en columna Q te podría servir.
    – Esei
    el 24 mar. 2019 a las 20:48
  • Hola Elier. si, me refiero a que haya datos. Que formula podria aplicar para que reemplace el valor de cada celda de la columna Q por el dato de la columna U? el 25 mar. 2019 a las 14:58

1 respuesta 1

0

No sé la cantidad de celdas que haya, en caso de que sean muchísimas esto se puede ralentizar y entonces te recomiendo utilizar un Array para agilizar todo esto. No obstante esto debería ayudarte:

Option Explicit
Sub Reemplazar()

    Dim C As Range, LastRow As Long, Criteria1 As String, Valor1 As String

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
        .DisplayAlerts = False
        .Calculation = xlCalculationManual
    End With

    Criteria1 = "NNNNNNNNNNN"

    With ThisWorkbook.Sheets("NombreDeTuHoja")
        LastRow = .Cells(.Rows.Count, "U").End(xlUp).Row
        For Each C In .Range("Q2:Q" & LastRow)
            If .Cells(C.Row, "U") <> vbNullString Then 'asumo que simplemente quieres que haya datos en la Columna U
                If .Cells(C.Row, "R") = Criteria1 Then 'aquí comprobamos si la columna R cumple el criterio
                    C = .Cells(C.Row, "U") 'en caso de que las dos condiciones se cumplan, la Q = U
                End If
            End If
        Next C
    End With

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
        .DisplayAlerts = True
        .Calculation = xlCalculationAutomatic
    End With    

End Sub
1
  • Muchas gracias Damian, me fue muy util el 28 mar. 2019 a las 15:01

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.