Buscar Valores a través de Macro para que no se vuelva pesada la hoja de excel

Te quiero preguntar si es posible llevar un consecutivo en una columna en la columna F, de acuerdo al dato en la columna B, D, E de una hoja.

Lo que pasa es que lo se hacer, pero con fórmulas, no con macros... Y se vuelve extensamente pesada la hoja si la formulo toda...

1 Respuesta

Respuesta
1

Quieres decir que el primer registros con estos datos:

¿605 Asadores 4 le corresponde el número 1?

¿Y si más adelante encuentro los mismos datos le toca el número 2?

La macro aplicaría, cada vez que cambies un dato de las columnas B, D y E, pero recalcularía el consecutivo de toda la columna F, por si algún dato se cambió.

Es correcto, le corresponde el numero 1.

Si vuelve a encontrar 605, asadores 4, va el 2. y así sucesivamente.

Esta perfecto...

Gracias

¿Puedo ordenar los datos de la hoja por esas 3 columnas?

No tengo problema, aunque si después puedes ordenar por fecha, quedaría mejor, que es como se van metiendo los datos...

Te anexo la macro

Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
    If Not Intersect(Target, Range("A:E, G:G")) Is Nothing Then
        Application.ScreenUpdating = False
        For Each c In Target
            Range("H2:I2").Copy Cells(c.Row, "H")
        Next
        Application.EnableEvents = False
        u = Range("A" & Rows.Count).End(xlUp).Row
        '
        With ActiveWorkbook.Worksheets("Hoja1").Sort
            .SortFields.Clear
            .SortFields.Add Key:=Range("B2:B" & u), _
                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SortFields.Add Key:=Range("D2:D" & u), _
                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SortFields.Add Key:=Range("E2:E" & u), _
                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SetRange Range("A1:I" & u)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        '
        an1 = Cells(2, "B")
        an2 = Cells(2, "D")
        an3 = Cells(2, "E")
        con = 0
        For i = 2 To u
            If an1 = Cells(i, "B") And _
               an2 = Cells(i, "D") And _
               an3 = Cells(i, "E") Then
                con = con + 1
            Else
                con = 1
            End If
            Cells(i, "F") = con
            an1 = Cells(i, "B")
            an2 = Cells(i, "D")
            an3 = Cells(i, "E")
        Next
        '
        With ActiveWorkbook.Worksheets("Hoja1").Sort
            .SortFields.Clear
            .SortFields.Add Key:=Range("A2:A" & u), _
                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .SetRange Range("A1:I" & u)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        '
        Application.EnableEvents = True
    End If
End Sub


Saludos. Dante Amor

¡Gracias!

Que locura...!

De verdad estoy muy agradecido con tu ayuda, me encantaría estudiar VBA para poder programar... En lo que pueda ayudar me encantaría...

De verdad agradezco de corazón el tiempo y dedicación para ayudar al prójimo.

Con mucho gusto.

Saludos. Dante Amor

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas