Reducir el proceso de la Macro

Tengo la siguiente macro que se ejecuta muy lento, la cual hace que mi trabajo sea un poco tedioso, la cual pido su apoyo en mejorarlo.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Fila As Long

Application.ScreenUpdating = False

Fila = ActiveCell.Row

If Target.Address(False, False) = "K" & Fila Then
If Target = "" Then Exit Sub

Call Concatenar
Call ConvertirFormulas
Call DuplicadosALERTA

Range("N7").End(xlDown).Offset(1, 0).Select

Application.ScreenUpdating = True

End If
End Sub

Las siguientes Call se forma asi:

Sub Concatenar()
Fila = 9
Do While Range("K" & Fila) <> ""
Range("L" & Fila) = "=CONCATENATE(TEXT(RC[-3],""0000""),""-"",RC[-1])"
Fila = Fila + 1
Loop

End Sub

Sub ConvertirFormulas()
Application.CutCopyMode = False

UltLinea = Range("K" & Rows.Count).End(xlUp).Row 'captura el número de la ultima fila con datos
UltCelda = "L" & UltLinea 'muestra el número de la ultima fila con su letra de columna
Range("L9", UltCelda).Copy: Range("L9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("L9").Select
Application.CutCopyMode = False
ActiveWorkbook.Save
End Sub

Sub DuplicadosALERTA()
Dim Fila As Long, final As Long
Dim FDuplicadas As String
final = Range("L9").End(xlDown).Row
FDuplicadas = ""
For Fila = 9 To final
If Application.WorksheetFunction.CountIf(Range("L9:L" & final), Range("L" & Fila)) > 1 Then
Range("L" & Fila).Interior.Color = RGB(200, 200, 200)
FDuplicadas = FDuplicadas & ", " & Fila
Else
Range("L" & Fila).Interior.Color = xlNone
End If
Next Fila
If FDuplicadas <> "" Then
MsgBox "Existen filas duplicadas en " & FDuplicadas
End If
End Sub

Espero me puedan ayudar en mejorar todo el proceso de la macro.

2 Respuestas

Respuesta
1

Suponiendo que vas ingresando los datos uno a uno, quizá esta macro te pueda servir

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Duplicado As Long
    Application.ScreenUpdating = False
    'MsgBox Target(1).Row & " " & Target(1).Column
    If Target(1).Row >= 9 And _
       Target(1).Column >= 9 And Target(1).Column <= 11 Then 'El número 9 es para la columna I y el 11 para la K'
       'Contar duplicados
       Duplicado = Application.WorksheetFunction.CountIfs( _
            Range("I:I"), Range("I" & Target(1).Row).Value, _
            Range("J:J"), Range("J" & Target(1).Row).Value, _
            Range("K:K"), Range("K" & Target(1).Row).Value)
          If Duplicado = 2 Then
            MsgBox "La combinación actual ya se encuentra en la lista"
          ElseIf Duplicado > 2 Then
            MsgBox "La fila " & Target(1).Row & " se encuentra " & Duplicado & " veces en el documento"
          End If
    End If
   Application.ScreenUpdating = True
End Sub

En el caso de existir un duplicado en la combinación I J K, entonces enviará un mensaje. Si lo aplicas cobre una tabla que ya tienes, sólo te dirá cuántas veces está repetido el valor, pero no te dirá dónde está, ya que la macro está pensada para el ingreso de fila en fila.

Buenas tardes Isaac:

Tengo una consulta adicional en este proceso, existe la forma que si el dato es duplicado no me deje grabar o eliminar solo esos campos dado que esta macro se ejecuta en un base de datos de 20 columnas.

Esperando su pronto apoyo.

Saludos.

¿Qué no deje grabar o eliminar qué?
¿Grabar el libro?

¿Eliminar una fila? ¿Eliminar un dato?

Dependiendo de lo que quieras, sí se podría hacer algo.

S@lu2

Buenas tardes:

En este caso seria el dato duplicado, o mejor dicho la celdas que corresponde el dato duplicado que no deje registrarlo, porque con la macro si me acepta.

Espero me puedas ayudar.

Saludos.

Tendríaque seralgo así

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Duplicado As Long
    Application.ScreenUpdating = False
    'MsgBox Target(1).Row & " " & Target(1).Column
    If Target(1).Row >= 9 And _
       Target(1).Column >= 9 And Target(1).Column <= 11 Then 'El número 9 es para la columna I y el 11 para la K'
       'Contar duplicados
       Duplicado = Application.WorksheetFunction.CountIfs( _
            Range("I:I"), Range("I" & Target(1).Row).Value, _
            Range("J:J"), Range("J" & Target(1).Row).Value, _
            Range("K:K"), Range("K" & Target(1).Row).Value)
          If Duplicado = 2 Then
            MsgBox "La combinación actual ya se encuentra en la lista"
            'Esta linea elimina los datos ingresados recientemente'
            Range("I" & Target(1).Row & ":K" & Target(1).Row).Value=""
          ElseIf Duplicado > 2 Then
            MsgBox "La fila " & Target(1).Row & " se encuentra " & Duplicado & " veces en el documento"
            'Esta linea elimina los datos ingresados recientemente'
            Range("I" & Target(1).Row & ":K" & Target(1).Row).Value=""
          End If
    End If
   Application.ScreenUpdating = True
End Sub

Le agregué la línea

Range("I" & Target(1).Row & ":K" & Target(1).Row).Value=""

Que elimina el conenido de las 3 celdas para que el valor no se repita.

S@lu2

Respuesta
1

El problema de tu macro reside en el evento Worksheet_SelectionChange cada vez que selecciones una celda va repetir todo el proceso de formular, convertir a valor, guardar y mostrar duplicados y esto hace lenta la maquina, por ejemplo si tienes 1000 filas va a correr las macros 1000 veces, de hecho hice la prueba en mi macro y no solo es muy lenta sino que inhibió mi excel, individualmente cada macro es rápida y puede ser mejorada para ser mucho más rápida formular y convertir a valor se pueden reducir a unas cinco instrucciones, el mostrar duplicados igual puede ser mejorada aunque estas mejoras de nada van a servir si mantienes la programación, e incluso las tres macros pueden hacerse una con muchas menos líneas de las que estas usando o con las mismas solo que programadas para un mejor rendimiento que el Worksheet_SelectionChange, ¿dime cuál es objetivo de este evento?, si quieres que te muestre si esta duplicado el dato hay mejores maneras de hacerlo sin un evento hoja, por cierto si puedes acompañar tu explicación con un pantallazo de tus datos servivira para darte una mejor respuesta.

Buenos días James:

Utilizo el Worksheet_SelectionChange, porque creo que cuando hay una modificación en la celda C3, C4, C5......................C100000 automáticamente hace correr la macro para convertir y verificar si hay duplicados en la celda D.

Por este motivo utilizo el Worksheet_SelectionChange para que ejecute la macro, si existiera otra forma, que cuando realice alguna modificación en la columna C (en este ejemplo es una referencia dado que puede ser AD y/o BC) ejecute la macro.

Agradeciendo de antemano tu tiempo.

Saludos.

Esta imagen, es una ejemplo de una macro simplificada, cada que ingreses o modifiques un dato en la columna C la macro te dirá cuantos duplicados hay sin necesidad de formular en la hoja, simplemente la formulación se hace mediante una función contar si conjunto el cual contatena las columnas A, B y C y busca en ella si existen duplicados, de existir te los va a mostrar en un msgbox


Buenos días James:

Cual es esa macro para poder cambiar todo la secuencia de la macro inicial.

Saludos.

Sorry olvide subir la macro que es esta, como te mencione solo se activa cuando se modifica un dato en la columna C, no ocupas formular en D porque con la variable cuenta se hace el concatenado y el conteo de repetidos

Private Sub Worksheet_Change(ByVal Target As Range)
COL = Target.Column
If COL = 3 Then
    Set DATOS = Range("A3").CurrentRegion
    With DATOS
        NUMERO = ActiveCell.Offset(-1, 0)
        SERIE = ActiveCell.Offset(-1, -1)
        TIPO = ActiveCell.Offset(-1, -2)
        CUENTA = WorksheetFunction.CountIfs(.Columns(1), TIPO, .Columns(2), SERIE, .Columns(3), NUMERO)
        if cuenta>1 then
        MsgBox (Format(TIPO, "000") & " " & Format(SERIE, "0000") _
        & " " & NUMERO & " REPETIDO " & CUENTA & " VECES"), vbInformation, "AVISO EXCEL"
        end if 
    End With
End If
Set DATOS = Nothing
End Sub

Buenas días James,

Al realizar el proceso me pide tener información desde la celda A1, cuando la información comienza a partir de la celda A9, a la vez las columnas A,B y C son columnas referenciales, cómo hago para que sean otras columnas.

Gracias

esta macro funciona a partir de la columna C9, numero=activecell.offset(-1,0) indica que recorrera una fila arriba de la posicion donde se encuentre despues de dar enter

serie=activecell.offset(-1,-1), indica que tomara el valor de la celda que esta una fila arriba y una columna la izquierda, el signo negativo indica que la macro tomara el valor de la celda que este x posiciones arriba o x posiciones a la izquierda, en positivo es que tomara el valor de la celda x posiciones abajo y/o y posiciones a la derecha, si quieres tomar otras referencias tienes que poner la cantidad de posiciones por ejemplo si quieres tomar el valor de la celda F el numero que corresponde a la columna F es 6 entonces tu referencia seria 

serie=activecell.offset(0,6)

0 le dirá a Excel que se mantenga en la misma fila o columna en este caso solo ira a la columna 6 de la misma fila.

set Datos=.currentregion le indica a la macro que haga una tabla (f x c) de datos virtual u objeto que se ira actualizando  cada que captures un dato con esto no tienes que usar do loop para buscar los duplicados, ya que la funcion countiifs se encarga de hacerlo concatenado los datos.

Private Sub Worksheet_Change(ByVal Target As Range)
COL = Target.Column
fila = Target.Row
If COL = 3 And fila >= 9 Then
    Set DATOS = Range("A9").CurrentRegion
    With DATOS
        NUMERO = ActiveCell.Offset(-1, 0)
        SERIE = ActiveCell.Offset(-1, -1)
        TIPO = ActiveCell.Offset(-1, -2)
        CUENTA = WorksheetFunction.CountIfs(.Columns(1), TIPO, .Columns(2), SERIE, .Columns(3), NUMERO)
        If CUENTA > 1 Then
        MsgBox (Format(TIPO, "000") & " " & Format(SERIE, "0000") _
        & " " & NUMERO & " REPETIDO " & CUENTA & " VECES"), vbInformation, "AVISO EXCEL"
        End If
    End With
End If
Set DATOS = Nothing
End Sub

Buenas Dias James:

Agradezco la aclaración en relación a la posición de las celdas, ahora observo que para que ejecute la macro debe darle tecla hacia abajo y/o enter, como esta data tiene aparte otras información, la verificación de duplicado solo se da en estas columnas pero se sigue llenando información en las columnas E, F, G......

Espero que me puedas ayudar en cambiar no solo con enter sino tecla derecha.

Saludos.

No entiendo lo que pides si das enter o flecha derecha se activara la macro y solo hará un análisis de repetidos si la celda activa esta en cualquier fila de la columna C fuera de esta columna la macro no hará nada es decir ignorara cualquier otra celda diferente a C9, C10, C11, C12... etc, todo lo demás lo ignorara, un detalle por default Excel trabaja con las flechas y con Enter para ingresar información estas no se pueden cancelar o anular si es lo que quieres.

Buenas tardes james:

Haber como explicar, la macro que me has enviado se ejecuta solo con enter, pero cuando le doy tecla derecha no me ejecuta, dado que parte de una base de datos es donde se verifica si hay datos duplicados, pero se sigue ingresando información en las siguientes celdas como por ejemplo en las columnas D, E,F,G,H......, al realizar el registro siguiente no me ejecuta nada.

Espero haber aclarado mi pregunta.

Saludos.

La tecla ni derecha ni izquierda van a funcionar por el simple hecho que la condición if esta programada para funcionar solo en la columna C, si vas a checar duplicados en la columna DE en adelante tienes que indicar en que columnas vas a validar duplicados tu ejemplo solo me indica que tienes una tabla de 3 columnas A, B, C por n filas así que la macro la diseñe para esas tres columnas, si es para más de 3 columnas entonces la macro requiere una programación diferente y si en las columnas DE, E, F, G tienes datos y estos los vas a validar también tienes que indicar si lo vas a hacer contra las columnas A, B u otras.

Buenos días James:

Este es la data donde trabajó con la macro, la columna H,I,K son las que se validan si hay duplicado pero para seguir registrado en las otras celdas L, M, N, ...... le doy tecla derecha para que pase a la celda siguiente, pero al hacer este procedimiento con la macro que has adjuntado no lo ejecuta.

Espero con esto aclarar un poco el procedimiento del uso de la macro.

Saludos.

Pues cambiaste tu petición inicial esto requiere de una macro nueva además tienes la columna M oculta y no explicasque hace con la columna N, la macro que ocupas es esta

Private Sub Worksheet_Change(ByVal Target As Range)
With Target
    col = .Column
    fila = .Row
    direccion = .Address
    If col = 11 And fila >= 9 Then
        With Range(direccion)
            tipo = .Cells(1, -1)
            titulo = .Cells(1, -2)
            numero = Target.Value
            CADENA = Format(tipo, "00") & " " & Format(titulo, "0000") & " " & numero
            cuenta = WorksheetFunction.CountIf(Columns(12), CADENA)
            If cuenta > 0 Then MsgBox (documento & " cadena " _
            & " repetido " & cuenta & " veces"), vbCritical, "AVISO": GoTo SIG
            .Cells(1, 2) = CADENA
        End With
    End If
End With
SIG:
End Sub

Hola James:

Ahora hay un problema dentro de toda esa base de datos tengo otra macro:

Sub LIMPIAR_COMPRAS()
If ActiveSheet.Index = 4 Then
CUO = Hoja8.Range("Ar1")
Hoja8.Range("B9:C" & CUO).Value = ""
Hoja8.Range("E9:I" & CUO).Value = ""
Hoja8.Range("K9:O" & CUO).Value = ""
Hoja8.Range("S9:AA" & CUO).Value = ""
Hoja8.Range("AC9:AC" & CUO).Value = ""
Hoja8.Range("AE9:AG" & CUO).Value = ""
Hoja8.Range("AI9:AR" & CUO).Value = ""
Hoja8.Range("AT9:AZ" & CUO).Value = ""
Hoja8.Range("BC9:BC" & CUO).Value = ""
Hoja8.Range("BF9:BF" & CUO).Value = ""
Hoja8.Range("BJ9:BJ" & CUO).Value = ""
Hoja8.Range("BQ9:BQ" & CUO).Value = ""
Call Repetirformulacion
Call Consecutivos
End If
End Sub

Que ejecutandolo me sale el siguiente error en la macro que me has enviado:

No se cual seria la solución para este problema.

Saludos.

Tu pantalla no muestra la línea donde marca el error, eso suele suceder cuando la variable es de un tipo por ejemplo single y el contenido de la celda es texto

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas