¿ Podria conseguir una macro de Excel con doble condición?

Necesitaría una macro que borrara filas si cumplen una doble condición:

COLUMNA A: Fecha

COLUMNA B: Proveedor

COLUMNA C: Nº Expediente

Condición: 2 o más valores de la columna C son iguales

Condición: Si cumple la 1ª condición, 2 o mas valores de la columna B deben ser también iguales

Si cumple esta doble condición borrar valor más antiguo de la columna A "Fecha"

Muchas gracias por adelantado

1 respuesta

Respuesta
1

En tu ejemplo tienes el expediente "120002", 6 veces con el proveedor "LAD" y todos con fecha "04/02//2015"

¿Cuál o cuáles hay que borrar?

Hola Dante,

Disculpa tenia error, la intención es borrar todas las filas con el expediente repetido que tenga mismo proveedor, excepto la que sea más nueva.

Adjunto fotograma corregido, gracias!

De todas formas, si me encuentro 2 registros con el mismo expediente, con el mismo proveedor y con la misma fecha, borro uno para que solamente te aparezca uno.

Gracias de nuevo, En ese caso habría que borrar el/los que tuviera la hora más antigua, y conservar solo uno, el más nuevo. Nuestro campo fecha es el que viene con la hora. Saludos

¿En dónde viene la hora?

La imagen que pusiste representa realmente las columnas como las tienes en la hoja, porque de acuerdo a esas columnas es como voy a crear la macro, pero si los datos están en otras columnas, la macro no va a funcionar.

Si disculpa,Seria en la misma columna A, lo único que la columna expediente, no necesariamente estará en C, aunque imagino que eso no es problema,

El resto de columnas como fecha y proveedor, tampoco estarán necesariamente en esa columna, aunque imagino que puedo yo indicar el rango en la macro posteriormente, o bien tu tomar toda la hoja, no lo sé

No es tan simple, es como una fórmula buscarv, tienes que decirle en qué columnas debe buscar.

No puedes poner la fórmula Buscarv y presionas enter y que la fórmula automáticamente intuya en dónde están los datos.

De igual forma me tienes que decir en qué columna están los datos.

Si hoy el expediente está en la columna "C" así va a funcionar la macro, si mañana cambias la columna del expediente a la "M" la macro ya no va a funcionar.

Si no estás seguro de dónde tienes tus datos, entonces tenemos un problema, no puedo crear la macro.

No hay problema Dante, estarían en un principio en las columnas de ejemplo, A, B y C, o ya me encargaría yo de moverlas. Gracias

Te anexo la macro.

Supongo que además de las columnas A, B y C tienes más columnas, entonces en esta parte de la macro, cambia la letra C por la última columna que tengas con datos.

SetRange h1.Range("A1:C" & u)

Por ejemplo si tu última columnas con datos es la "M" entonces en la macro debería quedar así:

SetRange h1.Range("A1:M" & u)

Sub BorrarFilas()
'Por.Dante Amor
'
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set h1 = Sheets("Hoja1")
    Set h2 = Sheets.Add
    'Set h2 = Sheets("Hoja4")
    'h2.Cells.Clear
    h1.Columns("C:C").Copy h2.[A1]
    h1.Columns("B:B").Copy h2.[B1]
    u = h1.Range("A" & Rows.Count).End(xlUp).Row
    '
    With h1.Sort
        .SortFields.Clear
        .SortFields.Add Key:=h1.Range("A2:A" & u), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=h1.Range("B2:B" & u), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add Key:=h1.Range("C2:C" & u), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange h1.Range("A1:C" & u)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    '
    h2.Range("A1:B" & u).RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
    h2.Range("A1:B1").Copy h2.[D1]
    For i = 2 To h2.Range("A" & Rows.Count).End(xlUp).Row
        h2.Range("A" & i & ":B" & i).Copy h2.[D2]
        If h1.FilterMode Then h1.ShowAllData
        h1.Range("A1:C" & u).AdvancedFilter Action:=xlFilterInPlace, _
            CriteriaRange:=h2.Range("D1:E2"), Unique:=False
        '
        u3 = h1.Range("A" & Rows.Count).End(xlUp).Row
        fin = u3
        If u3 > 2 Then
            For j = u3 - 1 To 2 Step -1
                If h1.Cells(j, "A").EntireRow.Hidden = False Then
                    h2.Cells(j, "G") = "x"
                End If
            Next
        End If
    Next
    '
    If h1.FilterMode Then h1.ShowAllData
    For k = u To 2 Step -1
        If h2.Cells(k, "G") = "x" Then
            h1.Rows(k).Delete
        End If
    Next
    h2.Delete
    Application.ScreenUpdating = True
    '
    MsgBox "fin"
End Sub

Saludos.Dante Amor

Hola Dante,

La macro funciona a la perfección, muchas gracias eres un autentico genio.

Te pediría una última cosa antes de cerrar el hilo si me permites:

Seria posible que me incluyeras la macro con:

COLUMNA A: Expediente

COLUMNA AU: Proveedor

COLUMNA T: Fecha

Mucha gracias

Tendría que cambiar la macro y volver a probarla.

Con gusto te hago el cambio.

Valora esta respuesta y crea una nueva para redefinir las columnas.

Saludos. Dante Amor

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas