Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Excel » Comparar ultima fila ingresada y eliminar si conciden 3 criterios

Excel - Comparar ultima fila ingresada y eliminar si conciden 3 criterios

Volver
Nuevo Tema
Filtrado por el usuario: Raul
<<>>
Filtrado por el usuario 'Raul' (Eliminar fitro)
 
Vista:

Comparar ultima fila ingresada y eliminar si conciden 3 criterios

Publicado por SERGIO GERARDO (2 intervenciones) el 26/02/2016 03:35:46
Buenas tardes, solicito su valioso apoyo con lo siguiente:

Por medio de una macro ingreso desde una hoja de excel "CAPTURA" (habilitada como forrmulario) a otra hoja "RELACION" los siguientes datos: Fecha, Folio, Clave, Descripción, Solicitado, Ministrado, Estatus, Surtido y Medico, lo que corresponde a la salida de medicamentos por medio de recetas, el codigo de captura funciona bien, solamente que algunos capturistas duplican la captura sin darse cuenta (oprimen el boton con singular alegria), en ocasiones mas de dos veces, lo que ocasiona que se obtenga informacion erronea en el inventario.

En fin, lo que se pretende es implementar dentro de mi macro un codigo que realice lo siguiente:
- Que al momento oprimir el boton copie los datos en la ultima fila, como ya lo hace, pero que verifique en las 2 ultimas filas en las columnas A (fecha), columna B (folio de la receta) y columna D (clave del medicamento) si son datos iguales, si es asi, me desplieque un msgbox "esta clave ya esta capturada" por ejemplo, y a continuacion borre la ultima fila con los datos duplicados.

Se pueden tener en cuenta las siguientes consideraciones que tal vez sirvan de ayuda:
- La clave del medicamento (col. D) se podria cambiar a la col. C si asi conviene a la creacion del codigo.
- No es necesario en mi parecer que recorra todas las filas buscando duplicados, ya que es poco probable (pero no imposible) que exista una fila anterior con los mismos datos.
- Tendria que ser a fuerzas con los tres criterios mencionados, ya que no sirve si compara todos los datos de la fila, porque los datos de las demas columnas pueden variar ocasionando que la ultima fila se diferente a la penultima aunque la fecha, folio y clave sea la misma, saltandose el duplicado.
- No dede tener 1 receta 2 claves iguales.
- Tal vez no sea necesario que copie los datos, tal vez si los detecta antes seria mejor, creo.

Espero haberme explicado lo suficiente, les agradezco de antemano, Sergio Davalos
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder

Comparar ultima fila ingresada y eliminar si conciden 3 criterios

Publicado por SERGIO GERARDO (2 intervenciones) el 26/02/2016 04:54:44
Investigando encontré este código que efectivamente detecta los duplicados en base a 3 criterios, solo que recorre toda la tabla para encontrarlos y borrarlos, para mi desesperacion tarda un poco en el proceso. Lo que ahora ocuparía es donde poner: Msgbox “Este registro ya existe, VERIFIQUE LOS DATOS” antes de que borre la fila repetida y si se puede adaptar para que verifique solo las dos ultimas filas.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Sub duplicates()
 
    Dim lastrow As Long
 
    With Worksheets("RELACION")
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            lastrow = .Cells.Find(What:="*", _
                          After:=.Range("A1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
        Else
            lastrow = 1
 
      End If
 
        'Array(1, 2, 4) son: 1 - para A, 2 para B y 4 para D columnas

 
        .Range("A1:J" & lastrow).RemoveDuplicates Columns:=Array(1, 2, 4), _
            Header:=xlYes
 
End With
 
End Sub


Gracias nuevamente, Sergio Davalos.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
sin imagen de perfil

Comparar ultima fila ingresada y eliminar si conciden 3 criterios

Publicado por agustin (149 intervenciones) el 26/02/2016 15:13:59
No terminé de entender realmente como quieres hacerlo pero aqui un pequeño codigo que me he creado para ver si te sirve.
1. Crea un nuevo modulo y mete este codigo dentro:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
Sub duplicates()
    Dim lastrow As Long
    Dim rango As Range
    Dim repe As Integer
    Dim respuesta As Integer
 
    'Uso un array de enteros para indicar las columnas que quiero comprobar

    Dim col(1 To 3) As Long
    'Uso una variable para indicar el numero de valores que contendrá el array

    Dim nCols As Integer
 
    'Inicializo el array con las columnas que deseo comprobar

    col(1) = 1
    col(2) = 2
    col(3) = 4
 
    'Indico que seran 3 columnas

    nCols = 3
 
    With Worksheets("RELACION")
        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
            lastrow = .Cells.Find(What:="*", _
                          After:=.Range("A1"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
        Else
            lastrow = 1
        End If
 
        'Array(1, 2, 4) son: 1 - para A, 2 para B y 4 para D columnas

        If lastrow > 1 Then
 
             Set rango = .Range("A" & (lastrow - 1) & ":J" & lastrow)
 
            'Con esta funcion que me he creado busco si hay algun duplicado en el rango y doy una respuesta booleana

            repe = FindDups(rango, col, nCols)
 
            If repe = True Then 'Si hay algun repetido...

                'Pregunto si desea borrar los duplicados

                respuesta = MsgBox("Se han creado datos duplicados y serán borrados", vbInformation Or vbYesNo, "Atención")
 
                'Si la respuesta es Si se borran los duplicados

                If respuesta = vbYes Then
                    rango.RemoveDuplicates Columns:=Array(1, 2, 4)
                End If
            End If
 
            Set rango = Nothing
        End If
    End With
End Sub
 
Function FindDups(ByRef rango As Range, ByRef col() As Long, nCols As Integer) As Boolean
    '

    ' NOTE: You must select the first cell in the column and

    ' make sure that the column is sorted before running this macro

    '

    Dim retval As Boolean
    Dim N As Long
    Dim contador As Integer
 
    retval = 0
    ScreenUpdating = False
 
    'Recorro el resto de filas del rango para buscar coincidencias con la ultima

    For Index = 1 To rango.Rows.Count - 1
        'Obtengo el valor para la primera columna de la fila indicada por el indice

        FirstItem = rango.Cells(Index, col(1)).Value
        'Obtengo el valor de la primera columna para la ultima fila que se ha ingresado

        LastItem = rango.Cells(rango.Rows.Count, col(1)).Value
 
        contador = 0 'Inicializo el contador para saber cuantas coincidencias hay el la fila

 
        If FirstItem = LastItem Then 'Si son iguales

            contador = contador + 1 'Incremento el contador

 
            'Recorro el resto de las columnas del array de columnas que deseo comprobar

            For N = LBound(col) + 1 To UBound(col)
                'Obtengo el valor de la celda en la fila indicada por el indice en la columna indicada por N

                FirstItem = rango.Cells(Index, col(N)).Value
                'Obtengo el valor de la celda en la ultima fila en la columna indicada por N

                LastItem = rango.Cells(rango.Rows.Count, col(N)).Value
                If FirstItem = LastItem Then 'Si son iguales incremento el contador

                    contador = contador + 1
                Else 'Si son diferentes salgo de este bucle

                    Exit For
                End If
            Next N
 
            'Si coinciden es porque coinciden los valores para las columnas indicadas

            'asi que salgo de este bucle porque ya hay al menos un duplicado

            If contador = nCols Then
                Exit For
            End If
        End If
    Next Index
 
    ScreenUpdating = True
    If contador = nCols Then 'Si hubo duplicado retorno True

        FindDups = True
    Else                     'de lo contrario retorno False

        FindDups = False
    End If
End Function
Ahora ve a la hoja que deseas aplicar el codigo y pon esto:
1
2
3
Private Sub Worksheet_Change(ByVal Target As Range)
    duplicates
End Sub
Yo lo he hecho en la hoja RELACION y en cuanto escribes una fila con las columnas que coinciden con las de otra fila funciona perfectamente. Ya me cuentas.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar