Macro que reste dos celdas de la misma fila

Tratando de entenderte
Hablas de resta de celdas de la misma fila, hablas de una condicional, hablas de sacar la fila en una celda del mismo libro y eliminándolas de la lista principal y de colorear por pares.
No encuentro la relación entre restar celdas; seleccionar una fila según una condición para luego sacarla en una celda y borrarla de la lista principal; y colorear por pares. ¿Cuál es la condición? ¿Qué tiene que ver la resta de celdas con la selección de la fila y con colorear por pares?
Podrías dar un ejemplo, creo que así te entiendo mejor.

Que tal !. supongo que así trabaja el foro cada experto desarrolla el mismo tema. Así que no tiene que ver lo que ya me ha contestado oro experto. Entonces entiendo que debo explicarte a ti.

La primera parte la entendiste tal cual.

Lo segundo es que la macro que me diste antes, no colorea digamos bien, pero si colorea varas filas que cumplen la condición que C=D=E=F, y como hiciste, las colorea por pares.

Pues bien ahora se trata que ya tengo la lista producto de la primera Macro gracias a ti, así que lo que quisiera es un segundo filtro que en esta ocasión compare las celdas de la columna B una por una y determine si la diferencia esta dentro de una intervalo que yo fije. Que decirte de 0 a 1000 por ejemplo.

Luego, si está dentro del intervalo la saca de la G2 en adelante. Por pares, tríos o las que cumplan con esta condición. Claro está que igual debe seguir conservando que C=D=E=F.

Acuérdate que no debe colorear sino copiar el formato de la celda que ya esta coloreada de la primera Macro.

Por ej.:
A B C D E F
1 t 25 j t h n
2 t 22 j t h n
3 e 17 h t f t
4 h 12 h t f t
5 r 9 l a j q

6 y 2 h e o m
Pues bien le digo que quiero que me saque todas las que están de la 1 a la 6 que la resta esté entre 0 y 6 por ej.. En este caso:
- (B1-B2)=3, (B1-B3)=8, no está.

- compara las celdas C,D,E y F; True,
- Así que saca la fila 1 y 2, conservando el color que tenían.
- Luego en el próximo loop empieza con B3 porque ya sacó 1 y 2,

- y hace lo mismo,
- (B3-B4)=5, está; (B3-B5)=8, no está;

- compara las celdas C,D,E y F; True,
- saca fila 3 y 4.
- Luego la 5, (B5-B6)=7; no está,
- no saca nada y va a la 6 y así hasta en la original hasta que se acaben los valores de la columna "B".

Me faltó aclararte que en la una va el encabezado. Pero espero se entienda ahora mas.

Nota: No deja la fila en la original porque se supone que ya esa seria la lista resultado final.

Gracias !!!

Mil perdones la comparación no es C=D=E=F, que dije??, es Cn=Cm.....Fn=Fm

Y la verdad amigo aquí hubo una confusión, te hice la pregunta creyendo que era como un mensaje privado. pero que no iba a quedar como otro tema. Y al aparecerme de nuevo pensé que podían haber dos expertos trabajando en lo mismo. Pero como hasta ahora DAM esta tratando de sacar un código desde ayer supongo que hay que esperar.

en tu ejemplo haces esto (B1-B2)=3, (B1-B3)=8, no está, la pregunta es ¿Una vez que se encuentras que (B1-B2)=3 esta en el rango entonces ya no deberías hacer la siguiente resta (B1-B3)=8 ya que la fila de B1 ya debería haberse eliminado de lista, es esto así? O ¿Tienes qué hacer todas las restas he ir sacando las que estén en dentro el rango sin portar que haya filas que se repitan dos veces en la lista final?

A ver. Debes seguir comparando la B1 porque no sabes si la B3 aun esta en el rango. Quizás entonces debes llevar un contador de las filas que vayan cumpliendo y luego al final que las busque en la lista original y las saque definitivamente.

Hola a18327. El otro experto hizo una buena parte, pero no le pareció parece que yo insistiera que faltaba poco. O no entendió que está cumpliendo la condición de quedarse en un intervalo numérico pero lo de conservar los colores nada que ver.

Yo le dije que pensaba que seria lo mas recomendable que luego de decidir que se cumplían todas los condiciones, sacar la fila completa copiando el color por supuesto.

Un error es que la columna G existe y el la sobrescribió en su código. Pero supongo que por ser mi error no lo corrigió. Yo traté de cambiar G por H pero no lo hace.

Su código da como resultado también filas que no cumplen con todas las condiciones de comparación.

Otro detalle en su código es que saca el resultado a otra hoja del mismo libro, que yo no lo hubiera hecho. Simplemente la sacaría al lado de la original dejando el espacio vacío.

Si te parece pego le código completo. Solo dime.

Visto que nadie contesta coloco el código que habría que corregir por si así se hace mas fácil:

Sub compara_numeros()
'por.dam
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
h2.Cells.Clear
'h1.Columns("G").Clear
h1.Rows(1).EntireRow.Copy h2.Range("A1")
h1.Select
Columns("A:F").Select
Selection.Sort Key1:=Range("B2"), Order1:=xlDescending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
uf = h1.Range("B" & Rows.Count).End(xlUp).Row
For i = 2 To uf
If Cells(i, "G") <> "X" Then
fini = i
For j = i + 1 To uf
If Cells(i, "B") - Cells(j, "B") >= 0 And _
Cells(i, "B") - Cells(j, "B") < 10 Then
ffin = j - 1
Else
Exit For
End If
Next
If j > uf Then ffin = ffin - 1
If ffin >= fini Then
h1.Range(Cells(fini, "Z"), Cells(ffin, "Z")) = "X"
'h1.Rows(fini & ":" & ffin).Copy _
'h2.Range("A" & h2.Range("B" & Rows.Count).End(xlUp).Row + 1)
End If
End If
Next
For i = 2 To uf
If h1.Cells(i, "Z") = "X" Then
h1.Rows(i).Copy h2.Range("A" & i)
h1.Rows(i).Clear
End If
Next
h2.Columns("Z").Clear
End Sub

---------------------------------------

Muchas Gracias !!

Lo pude corregir para que me trabajara, y lo logré, pero lo que ocurre es que no hace el condicional de comparación entre celdas. Y si uno le aumenta el intervalo, sencillamente saca todas las filas de la lista original a la "Hoja2". Tampoco los esta sacando por grupos de coincidencia.

Este es el codigo:

Sub compara_numeros()
'por.dam
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
h2.Cells.Clear
'h1.Columns("G").Clear
h1.Rows(1).EntireRow.Copy h2.Range("A1")
h1.Select
Columns("A:G").Select
Selection.Sort Key1:=Range("B2"), Order1:=xlDescending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
uf = h1.Range("B" & Rows.Count).End(xlUp).Row
For i = 2 To uf
If Cells(i, "H") <> "POR" Then
fini = i
For j = i + 1 To uf
If Cells(i, "B") - Cells(j, "B") >= 0 And _
Cells(i, "B") - Cells(j, "B") < 100 Then
ffin = j - 1
Else
Exit For
End If
Next
If j > uf Then ffin = ffin - 1
If ffin >= fini Then
h1.Range(Cells(fini, "Z"), Cells(ffin, "Z")) = "POR"
'h1.Rows(fini & ":" & ffin).Copy _
'h2.Range("A" & h2.Range("B" & Rows.Count).End(xlUp).Row + 1)
End If
End If
Next
For i = 2 To uf
If h1.Cells(i, "Z") = "POR" Then
h1.Rows(i).Copy h2.Range("A" & i)
h1.Rows(i).Clear
End If
Next
h2.Columns("Z").Clear
End Sub

Siento no poder contestarte rapido, es que estoy entretenido con otras cosas.
Veo la macro que pones y no se parece a lo que yo entendí que quieres hacer.
Vamos de nuevo a ver que necesitas. Suponiendo que el rango tiene 1000 filas, entonces
Quieres hacer la resta de la columna B de cada fila con las demás filas, esto es

$$\begin{align}&B1-B2, B1-B3, B1-B4, ..., B1-B1000\\ &B2-B3,B2-B4,B2-B5,...B2-B1000\\ &.\\ &.\\ &.\\ &B999-B1000\end{align}$$

y los resultados de las restas deben estar dentro de un rango de números que tu especifiques como por ejemplo de 1 a 10.
Ahora que pasa en estas situaciones

Cuando encuentro que B1-B3 se encuentra en entre 1 y 10, muevo la fila de B1 y B3 a otra parte del hoja ¿qué sigue después, continuo con B1-B4, B1-B5,... B1-B1000 o continuo con B2-B3, B2-B4,..., B2-B1000?

En algunas ocasiones se va a tener por ejemplo B2-B5 y resulta que B5 ya se ha eliminado, ¿Se debe o no se debe saltar esa resta?, ten en cuenta que si no se debe saltar la resta entonces se podría tener dos veces la fila de B5 en la nueva lista.

En algunas ocasiones se va a tener por ejemplo B2-B5 y resulta que B2 ya se ha eliminado, ¿Se debe o no se debe saltar esa resta?, ten en cuenta que si no se debe saltar la resta entonces se podría tener dos veces la fila de B5 en la nueva lista.

Hola.No te preocupes, aproveche con la tardanza y tuve la cocasión de aprender algunas cosas de VB.

Por ej.:

Intervalo = 0<Y<500
A B C D E F

1 100

2 200
3 500
4 800

.

.

n

- En este caso B1-B2; B1-B3. dentro

- B1-B4, fuera

- Luego B2-B3, dentro

- B2-B3, dentro

Pues viendo el ejemplo creo que es mas sencillo que si termina de comparar B1 con las demás, comience de nuevo con B2 y compare hasta que no se cumpla. Lo importante es que cada grupo que cumpla con que la resta este en el rango, debe antes de salir cumplir también con: Cn=Cm; Dn=Dm; En=En y Fn=Fm. De no ser así no salen. Los colores según he podido ver producto de la otra macro "Colores.Repetidos", los grupos donde se cumplen las 4 condiciones de comparación tienen el mismo color (aunque no se porque colorea muchas que no cumplen). Así que seria cuestión de solo cortar y sacar las filas que cumplan y colocarlas al lado a partir de H2 (en H1 va el encabezado) quedando de esta forma todas agrupadas por color.

Ojalá me haya podido explicar mejor.

Se me olvidaba con respecto a que si no se saca las filas se pueden repetir .Se me ocurre que luego habría que darle una pasada y eliminar las repetidas. Hay una herramienta en Excel que quita las duplicados, así que en la Macro podría hacerse para que no saliera una lista final con duplicados. La otra es hacer una comparación antes de sacarla por si acaso ya esta afuera, pero lo veo como engorroso. Y yo sin saber VB te imaginaras.

Hola a18327 y cualquiera que pueda esta trabajando con este código.

Yo siempre trabajé con Excel y muy poco o casi nada con Access, pero resultó que hoy se me ocurre ponerme a ver si lograba hacer algo con este programa y el resultado ha sido sencillamente increíble.

Hace exactamente lo que busco con la herramienta Asistente de Consultas.

Solo me falta algo que es muy importante, colorear con el mismo color todas los grupos que hayan cumplido con las condiciones.

El único problema es que Access me da la lista que yo buscaba pero todas las filas con fondo blanco. Y claro está me interesan mucho los colores para distinguirlas mejor, sobre todo cuando hay grupos de 3, 4 o mas coincidencias.

Así que yo diría que si alguien sabe que esto sea posible en Access pasándole una Macro a la lista resultado p. ej., pues nada, asunto resuelto, pero si no, ojalá y alguien pueda hacer el código para el Excel.

Solo quería avisar para no hacer trabajar a nadie de mas.

Muchas Gracias !!

Podrías mostrar la consulta sql que te genero el asistente de consultas. Con la consulta podría saber exactamente que es lo que quieres hacer.

La consulta la hice en Access, Crear > "Asistente para Consultas", luego "Asistente para búsqueda de duplicados", luego 4 Campos de coincidencia y luego 3 para que los mostrara (son en total 7 columnas). Así obtuve la lista que quería. Lo único que falta es que los grupos de filas donde se cumplen las coincidencias tienen fondo blanco y necesito que cada grupo este en un diferente color.

Espero que así haya contestado tu pregunta.

Buenos Días !. Si se trata de colorear las filas con coincidencias solo como un ejemplo ilustrativo con ERRORES MAYÚSCULOS de compilación porque no conozco el idioma. Solo para tratar de explicar lo que quiero para colorear la lista que me arroja el Access. Pura lógica digamos.

El código base ni siquiera lo hice yo, es uno que encontré en este mismo foro.

Este seria el código EJEMPLO . NO FUNCIONA !!!!. DESASTROSO !!!

ColorearCeldasCoincidencias()
Dim mi_valor 1 As String
Dim mi_valor 2 As String
‘aqui el valor del primer color
I=255
'esto es solo para que se entienda la lógica

Range("C1").Select
Range("D1").Select
mi_valor1 = ActiveCell.Value1
mi_valor2 = ActiveCell.Value 2
Do While ActiveCell1.Value 1 <> ""
Do While ActiveCell2.Value 2 <> ""
‘ahora se supone que voy a comparar celdas C y D a ver si coinciden. La idea es colocar a comparar hasta 4 al mismo tiempo.

If ActiveCell.Value1 = mi_valor1 & ActiveCell.Value2 = mi_valor2 Then

‘aqui puede ir un condicional del color para cambiarlo a medida que vaya encontrando grupos con coincidencias
‘aqui debe ir una instrucción para colorear todo la fila de A:G; el mismo por grupos de coincidencias
ActiveCell1.Offset(1, 0).Select ActiveCell2.Offset(1, 0).Select
.
.
.
End If
Loop
End Sub

Espero con esto poder ayudar en vez de enredar.

Gracias !!!

Como que no he aclarado un punto importante y nadie tampoco me lo ha pedido, pero las celdas C,D,E,F son de texto.

Te tengo dos macros, una que colorea las filas repetidas, y que mueve(no elimina) las filas cuya resta este en un rango de valores especificado en otra lista;

Y otra macro que elimina las filas vacías dejada por la primera macro ya que la primera macro solo mueve las filas dejando un espacio vacío donde se esta quitando la fila.

Las macros están comentadas para entiendas mejor que es lo que hace cada linea y asi entender mejor la macro en su totalidad.

Sub ColorearRepetidos6()
    On Error Resume Next 'Evita que se detenga la macro al ocurrir un error
    Application.ScreenUpdating = False 'Evita que la pantalla parpadee mienstras se ejecuta la macro
    Dim Rango As Excel.Range 'Es el rango de celdas de tus datos
    Dim Datos As Variant 'Esta variable tendrá tus datos, solo datos
    Dim Columnas As Variant 'Esta variable tendrá los numeros de columnas que quieres comparar
    Dim Igual As Boolean 'Variable que indicara si todas las columnas a comparar coincidieron
    Dim i As Double 'Variable que servira para recorrer las filas del rango, indicara la fila a comparar
    Dim j As Double 'Variable que servira para recorrer las filas del rango, indicara la fila con la que se esta comparando la fila a comparar
    Dim k As Double 'Variable que servira para recorrer las columnas a comparar del rango
    Dim color As Double 'Variable que guardara el color que se le asignara a cada grupo de filas repetidas
    Dim Tiempo As Double 'Variable que indicara cuanto tiempo en minutos se ejecutara la macro
    Dim TiempoInicio As Date 'Variable que guardara el momento en que se inicio la macro
    Dim CeldaFilaComparar As Excel.Range 'Celda que guardara la fila en que se quedó la macro cuando se termine su tiempo de ejecución
    Dim FilaInicio As Double 'Sera la fila en la que va a iniciar/continuar la macro, se calcula en base a que fila se haya quedadó la macro antes de terminar su ejecución
    Dim ColumnaResta As Integer 'Es el numero de columna que se va a restar para ver si se encuentra dentro del rango de valores minimo y maximo
    Dim CeldaInicioNuevaLista As Excel.Range 'Es la celda donde va a iniciar la nueva lista con las filas repetidas cuya resta este en el rango de valores minimo y maximo
    Dim FilaVaciaNuevaLista As Double ' Será la fila de la lista nueva donde se va a insertar una fila repetida
    Dim ValorMinimoResta As Double 'Valor minimo del rango en que debe estar la resta
    Dim ValorMaximoResta As Double 'Valor maximo del rango en que debe estar la resta
    'Comienzan las Variables que debes Modificar
    Tiempo = 1 'La macro se ejecutara durante un minuto
    Set CeldaFilaComparar = ActiveSheet.Range("AA1") 'La Celda que tendra la Fila en que se quedó la macro al terminar su ejecución sera la AA1
    Set CeldaInicioNuevaLista = ActiveSheet.Range("H1") 'La celda donde comenzara la nueva lista sera la H1
    Columnas = Split("3,4,5,6", ",") 'Las columnas que se van a comparar son la numero 3, la numero 4, la numero 5 y la numero 6
    ColumnaResta = 2 'La columna que se va a estar es la columna numero 2
    ValorMinimoResta = 10 'El valor minimo del rango donde deben estar las restas es 10
    ValorMaximoResta = 100 'El valor maximo del rango donde deben estar las restas es 10
    'Terminan las variables que debes modificar
    Set Rango = Selection 'El rango de los datos a comparar es el rango que se tenga seleccionado en el momento de ejecutar la macro
    TiempoInicio = Now 'El tiempo de inicio de ejecución de la macro es Ahora(Now)
    Datos = Rango 'Se pasan los datos del rango a la variable Datos
    If Val(CeldaFilaComparar) = 0 Then 'Si la celda con la fila de inicio tiene un valor no numerico, no tienen nada o tienen cero
        FilaInicio = LBound(Datos) 'La fila de inicio es la primera fila de los datos
    Else 'Si no es asi
        FilaInicio = Val(CeldaFilaComparar) 'la fila de inicio es la fila que esta en la CeldaFilaComparar, es decir la celda AA1
    End If
    For i = FilaInicio To UBound(Datos) 'Recorrer los datos desde la fila de inicio hasta la ultima fila de datos
        If Rango.Cells(i, 1).Interior.color = 16777215 Then 'si el color de la primera celda de la fila i es 16777215, es decir si es blanco
            For j = i + 1 To UBound(Datos) 'Recorrer los datos desde la fila siguiente a la fila i hasta la ultima fila de los datos
                If Rango.Cells(j, 1).Interior.color = 16777215 Then 'si el color de la primera celda de la fila j es 16777215, es decir blanco
                    Igual = True 'Se asume que todas las columnas son iguales
                    For k = LBound(Columnas) To UBound(Columnas) 'Recorrer las columnas a comparar
                        If Datos(i, Val(Columnas(k))) <> Datos(j, Val(Columnas(k))) Then 'Si la columna k de la fila i es distinto de la columna k de la fila j
                            Igual = False 'Igual es falso porque no coinciden las columnas
                        End If
                    Next
                    If Igual = True Then 'Si igual es verdadero
                        color = RGB(Int((200 * Rnd) + 1), Int((200 * Rnd) + 1), Int((200 * Rnd) + 1)) 'Se obtiene un color aleatorio
                        If Rango.Resize(1).Offset(i - 1).Interior.color = 16777215 Then 'Si el color de la fila i es 16777215, es decir blanco
                            Rango.Resize(1).Offset(i - 1).Interior.color = color 'Se pinta de color la fila i
                        End If
                        Rango.Resize(1).Offset(j - 1).Interior.color = color 'Se pinta de color la fiila j
                        FilaVaciaNuevaLista = CeldaInicioNuevaLista.Resize(1, Rango.Columns.Count).End(xlDown).Offset(1, 0).Row 'Se busca la primera fila vacia apartir de la celda de inicio de la nueva lista
                        If Datos(i, ColumnaResta) - Datos(j, ColumnaResta) >= ValorMinimoResta And Datos(i, ColumnaResta) - Datos(j, ColumnaResta) <= ValorMaximoResta Then 'Se verifica que la columna resta es decir la numero 2 de la fila i menos la columna resta de la fila j sea mayor o igual que el valor minimo y menor o igual que el valor maximo del rango permitido
                            If Application.CountBlank(Rango.Resize(1).Offset(i - 1)) < Rango.Columns.Count Then 'Se verifica que la fila i al menos tenga un valor en alguna de sus columnas, esto es que el numero de columnas vacías sea menor que el numero de columnas totales
                                Rango. Resize(1).Offset(i - 1). Cut CeldaInicioNuevaLista. Resize(1, Rango. Columns. Count). Offset(FilaVaciaNuevaLista - 1) 'Se mueve de la fila i a la nueva lista en la fila vacia encontrada
                                Rango. Resize(1).Offset(j - 1). Cut CeldaInicioNuevaLista. Resize(1, Rango. Columns. Count). Offset(FilaVaciaNuevaLista) 'Se mueve la fila j a la nueva lista en la fila superior a la fila vacia encontrada
                            Else 'Si no es asi(quieres decir que la fila i esta vacia)
                                Rango. Resize(1).Offset(j - 1). Cut CeldaInicioNuevaLista. Resize(1, Rango. Columns. Count). Offset(FilaVaciaNuevaLista - 1) 'Se mueve la fila j a la nueva lista en la fila vacia encontrada
                            End If
                        End If
                    End If
                End If
            Next            
        End If
        If DateAdd("n", Tiempo, TiempoInicio) < Now Then 'Si la suma del tiempo de inicio mas los minutos de ejecución que se le ha asignado a la macro es menor al tiempo actual(now)
             CeldaFilaComparar = i + 1 'Se guarda la fila i en que se quedo la macro en la CeldaFilaComparar
             Exit Sub 'Termina la macro
         End If
    Next
    Application.ScreenUpdating = True 'Se activa la actualización de la pantalla(para que no se quede como congelada)
End Sub

Sub EliminarFilasVacias()
    On Error Resume Next 'Evita que se detenga la macro al ocurrir un error
    Application.ScreenUpdating = False 'Evita que la pantalla parpadee mienstras se ejecuta la macro
    Dim Rango As Excel.Range 'Es el rango de celdas de tus datos
    Dim i As Double 'Variable que servira para recorrer las filas del rango, indicara la fila a revisar
    Dim Tiempo As Double 'Variable que indicara cuanto tiempo en minutos se ejecutara la macro
    Dim TiempoInicio As Date 'Variable que guardara el momento en que se inicio la macro
    Dim CeldaFilaRevisar As Excel.Range 'Celda que guardara la fila en que se quedó la macro cuando se termine su tiempo de ejecución
    Dim FilaInicio As Double 'Sera la fila en la que va a iniciar/continuar la macro, se calcula en base a que fila se haya quedadó la macro antes de terminar su ejecución
    'Comienzan las variables que debes modificar
    Tiempo = 1 'La macro se ejecutara durante un minuto
    Set CeldaFilaRevisar = ActiveSheet.Range("AA2") 'La Celda que tendra la Fila en que se quedó la macro al terminar su ejecución sera la AA2
    'Terminan las variables que debes modificar
    Set Rango = Selection 'El rango de los datos a revisar es el rango que se tenga seleccionado en el momento de ejecutar la macro
    TiempoInicio = Now 'El tiempo de inicio de ejecución de la macro es Ahora(Now)
    If Val(CeldaFilaRevisar) = 0 Then 'Si la celda con la fila de inicio tiene un valor no numerico, no tienen nada o tienen cero
        FilaInicio = LBound(Datos) 'La fila de inicio es la primera fila de los datos
    Else 'Si no es asi
        FilaInicio = Val(CeldaFilaRevisar) 'la fila de inicio es la fila que esta en la CeldaFilaRevisar, es decir la celda AA1
    End If
    For i = FilaInicio To Rango.Rows.Count 'Recorrer los datos desde la fila de inicio hasta la ultima fila del rango
        If Application.CountBlank(Rango.Resize(1).Offset(i - 1)) = Rango.Columns.Count Then 'Se verifica que todas las columnas de la fila i sean vacías
            Rango. Resize(1).Offset(i - 1).Delete xlShiftUp 'Elimina la fila i, y las filas se corren hacia arriba
        End If
        If DateAdd("n", Tiempo, TiempoInicio) < Now Then 'Si la suma del tiempo de inicio mas los minutos de ejecución que se le ha asignado a la macro es menor al tiempo actual(now)
            CeldaFilaRevisar = i + 1 'Se guarda la fila i en que se quedo la macro en la CeldaFilaRevisar
            Exit Sub 'Termina la macro
        End If
    Next
    Application.ScreenUpdating = True 'Se activa la actualización de la pantalla(para que no se quede como congelada)
End Sub

Estaba ahora justamente rompiéndome la cabeza tratando de corregir los errores de compilación y ver si lograba algo. Muchas gracias la pruebo y te aviso !!!

Estaba probando la primera macro y veo que hay errores. Te la vuelvo a mandar ya corregido y testeado. La segunda macro funaciona bien.

Sub ColorearRepetidos6()
    On Error Resume Next 'Evita que se detenga la macro al ocurrir un error
    Application.ScreenUpdating = False 'Evita que la pantalla parpadee mienstras se ejecuta la macro
    Dim Rango As Excel.Range 'Es el rango de celdas de tus datos
    Dim Datos As Variant 'Esta variable tendrá tus datos, solo datos
    Dim Columnas As Variant 'Esta variable tendrá los numeros de columnas que quieres comparar
    Dim Igual As Boolean 'Variable que indicara si todas las columnas a comparar coincidieron
    Dim i As Double 'Variable que servira para recorrer las filas del rango, indicara la fila a comparar
    Dim j As Double 'Variable que servira para recorrer las filas del rango, indicara la fila con la que se esta comparando la fila a comparar
    Dim k As Double 'Variable que servira para recorrer las columnas a comparar del rango
    Dim color As Double 'Variable que guardara el color que se le asignara a cada grupo de filas repetidas
    Dim Tiempo As Double 'Variable que indicara cuanto tiempo en minutos se ejecutara la macro
    Dim TiempoInicio As Date 'Variable que guardara el momento en que se inicio la macro
    Dim CeldaFilaComparar As Excel.Range 'Celda que guardara la fila en que se quedó la macro cuando se termine su tiempo de ejecución
    Dim FilaInicio As Double 'Sera la fila en la que va a iniciar/continuar la macro, se calcula en base a que fila se haya quedadó la macro antes de terminar su ejecución
    Dim ColumnaResta As Integer 'Es el numero de columna que se va a restar para ver si se encuentra dentro del rango de valores minimo y maximo
    Dim CeldaInicioNuevaLista As Excel.Range 'Es la celda donde va a iniciar la nueva lista con las filas repetidas cuya resta este en el rango de valores minimo y maximo
    Dim strCeldaInicioNuevaLista As String 'guarda la direccion de la celda de inicio de la nueva lista por ejemplo guarda "H1"
    Dim FilaVaciaNuevaLista As Double ' Será la fila de la lista nueva donde se va a insertar una fila repetida
    Dim ValorMinimoResta As Double 'Valor minimo del rango en que debe estar la resta
    Dim ValorMaximoResta As Double 'Valor maximo del rango en que debe estar la resta
    'COMIENZAN LAS VARIABLES QUE DEBES CAMBIAR
    Tiempo = 1 'La macro se ejecutara durante un minuto
    Set CeldaFilaComparar = ActiveSheet.Range("AA1") 'La Celda que tendra la Fila en que se quedó la macro al terminar su ejecución sera la AA1
    Set CeldaInicioNuevaLista = ActiveSheet.Range("H1") 'La celda donde comenzara la nueva lista sera la H1
    Columnas = Split("3,4,5,6", ",") 'Las columnas que se van a comparar son la numero 3, la numero 4, la numero 5 y la numero 6
    ColumnaResta = 2 'La columna que se va a estar es la columna numero 2
    ValorMinimoResta = 10 'El valor minimo del rango donde deben estar las restas es 10
    ValorMaximoResta = 100 'El valor maximo del rango donde deben estar las restas es 10
    'terminan las variables que debes cambiar
    Set Rango = Selection 'El rango de los datos a comparar es el rango que se tenga seleccionado en el momento de ejecutar la macro
    TiempoInicio = Now 'El tiempo de inicio de ejecución de la macro es Ahora(Now)
    Datos = Rango 'Se pasan los datos del rango a la variable Datos
    If Val(CeldaFilaComparar) = 0 Then 'Si la celda con la fila de inicio tiene un valor no numerico, no tienen nada o tienen cero
        FilaInicio = LBound(Datos) 'La fila de inicio es la primera fila de los datos
    Else 'Si no es asi
        FilaInicio = Val(CeldaFilaComparar) 'la fila de inicio es la fila que esta en la CeldaFilaComparar, es decir la celda AA1
    End If
    For i = FilaInicio To UBound(Datos) 'Recorrer los datos desde la fila de inicio hasta la ultima fila de datos
        If Err.Description <> "" Then 'Revisar que no haya ningun error que pueda ciclar la macro
            MsgBox "Debes Seleccionar un rango de mas de una celda" 'muestra un mensaje
            Exit Sub 'Termina la macro
        End If
        color = RGB(Int((200 * Rnd) + 1), Int((200 * Rnd) + 1), Int((200 * Rnd) + 1)) 'Se obtiene un color aleatorio con el que se colorearan las filas que coincidan con la fila i
        If Rango.Cells(i, 1).Interior.color = 16777215 Then 'si el color de la primera celda de la fila i es 16777215, es decir si es blanco
            For j = i + 1 To UBound(Datos) 'Recorrer los datos desde la fila siguiente a la fila i hasta la ultima fila de los datos
                If Rango.Cells(j, 1).Interior.color = 16777215 Then 'si el color de la primera celda de la fila j es 16777215, es decir blanco
                    Igual = True 'Se asume que todas las columnas son iguales
                    For k = LBound(Columnas) To UBound(Columnas) 'Recorrer las columnas a comparar
                        If Datos(i, Val(Columnas(k))) <> Datos(j, Val(Columnas(k))) Then 'Si la columna k de la fila i es distinto de la columna k de la fila j
                            Igual = False 'Igual es falso porque no coinciden las columnas
                        End If
                    Next
                    If Igual = True Then 'Si igual es verdadero
                        If Rango.Resize(1).Offset(i - 1).Interior.color = 16777215 Then 'Si el color de la fila i es 16777215, es decir blanco
                            Rango.Resize(1).Offset(i - 1).Interior.color = color 'Se pinta de color la fila i
                        End If
                        Rango.Resize(1).Offset(j - 1).Interior.color = color 'Se pinta de color la fiila j
                        If Application.CountBlank(CeldaInicioNuevaLista.Resize(1, Rango.Columns.Count)) = Rango.Columns.Count Then 'Si la primera fila de la nueva lista esta vacia
                            FilaVaciaNuevaLista = 1 'La fila vacia en la nueva lista es la fila 2
                        ElseIf Application.CountBlank(CeldaInicioNuevaLista.Resize(1, Rango.Columns.Count).Offset(1)) = Rango.Columns.Count Then 'Si la segunda fila de la nueva lista esta vacia
                            FilaVaciaNuevaLista = 2 'La fila vacia en la nueva lista es la fila 3
                        Else 'Si no
                            FilaVaciaNuevaLista = CeldaInicioNuevaLista.Resize(1, Rango.Columns.Count).End(xlDown).Offset(1, 0).Row 'Se busca la primera fila vacia apartir de la celda de inicio de la nueva lista, nota que para hacer esto minimo se necitan dos filas no vacias, es por eso que se debe comprobar primero las primeras dos filas y si no estan vacias entonces se usa esta forma
                        End If
                        If Math.Abs(Datos(i, ColumnaResta) - Datos(j, ColumnaResta)) >= ValorMinimoResta And Math.Abs(Datos(i, ColumnaResta) - Datos(j, ColumnaResta)) <= ValorMaximoResta Then 'Se verifica que el valor absoluto de la resta de la columna resta es decir la numero 2 de la fila i y la columna resta de la fila j sea mayor o igual que el valor minimo y menor o igual que el valor maximo del rango permitido
                            If Application.CountBlank(Rango.Resize(1).Offset(i - 1)) < Rango.Columns.Count Then 'Se verifica que la fila i al menos tenga un valor en alguna de sus columnas, esto es que el numero de columnas vacias sea menor que el numero de columnas totales
                                Rango. Resize(1).Offset(i - 1). Copy CeldaInicioNuevaLista. Resize(1, Rango. Columns. Count). Offset(FilaVaciaNuevaLista - CeldaInicioNuevaLista. Row) 'Se mueve de la fila i a la nueva lista en la fila vacia encontrada
                                Rango. Resize(1).Offset(j - 1). Copy CeldaInicioNuevaLista. Resize(1, Rango. Columns. Count). Offset(FilaVaciaNuevaLista - CeldaInicioNuevaLista. Row + 1) 'Se mueve la fila j a la nueva lista en la fila superior a la fila vacia encontrada
                                Rango. Resize(1).Offset(i - 1). ClearContents 'Se elimina valores de la fila i
                                Rango. Resize(1).Offset(j - 1). ClearContents 'Se elimina valores de la fila j
                            Else 'Si no es asi(quieres decir que la fila i esta vacia)
                                Rango. Resize(1).Offset(j - 1). Copy CeldaInicioNuevaLista. Resize(1, Rango. Columns. Count). Offset(FilaVaciaNuevaLista - CeldaInicioNuevaLista. Row) 'Se mueve la fila j a la nueva lista en la fila vacia encontrada
                                Rango. Resize(1).Offset(j - 1). ClearContents 'Se elimina valores de la fila j
                            End If
                        End If
                    End If
                End If
            Next
        End If
        Err.Clear 'Borra cualquier error que haya ocurrido
        If DateAdd("n", Tiempo, TiempoInicio) < Now Then 'Si la suma del tiempo de inicio mas los minutos de ejecución que se le ha asignado a la macro es menor al tiempo actual(now)
            CeldaFilaComparar = i + 1 'Se guarda la fila i en que se quedo la macro en la CeldaFilaComparar
            Exit Sub 'Termina la macro
        End If
    Next
    Application.ScreenUpdating = True 'Se activa la actualización de la pantalla(para que no se quede como congelada)
End Sub

Solo te voy diciendo.

- Ejecuté la primera Macro ColoresRepetidos6 con unas 5000 filas (La original tiene como 100.000). - Le pase la primera sin variar el tiempo (1 min). Vi el resultado y si me parecido que eran como pocas. No movió las filas, las coloreo en la misma lista.

- Entonces le pase la segunda Macro dejando la selección anterior a ver si habían cambios, y me pareció no notar nada. Así que como note que las filas no estaban agrupadas por color sino dispersas en la misma lista, procedí a ordenarlas por color de celda, y aparecieron dos pares.

- Que te digo que para el rango de 0<por<10 es como lógico que fueran tan pocas. Pero resultó que los dos pares que sacó tienen una diferencia mucho mayor que 10 restando las celdas de la columna 2 (B). Como si no hiciera esta comparación numérica.

Ahora estoy pasando la primera Macro ColoresRepetidos que estaba usando a ver si con las mismas 5000 filas, sin poder filtrar las que cumplan estar dentro de un mismo intervalo numérico, cuantas repetidas salen mas o menos. Pero como tarda mucho mas de un minuto por ese lado seguro serán muchas mas.

NOTA1: Ya tengo que pararla y probar de nuevo porque a veces pasa que se traba el Excel, y no son tantas celdas (5.000). Me ocurre que corre mejor si abro otro libro aparte. Como que aunque selecciono unas pocas de la lista grande confunde al Excel. No se.

NOTA2: Listo!! como te dije, colocando la lista de 5.000 en otro libro se ejecutó en unos 3 mins y salieron como unos 15 grupos de repetidos con concidiencias en las 4 columnnas. Las restas de algunos de la columna 2 son hasta menores que las que resultaron de la ColorearRpetidos.

Si dejas un minuto van a ser pocas las filas repetidas que va a encontrar, si revisas la celda AA1 puedes ver en que fila se quedo la macro para que tengas una idea de cuantas filas comparó. Ya que cuando la macro termina después del minuto no quiere decir que ya termino de comparar las 5000 filas si no que de las 5000 por ejemplo comparo 1000, entonces en la celda AA1 debe estar el número 1001. Y cuando vuelvas a ejecutar la macro comenzara con la fila 1001 y se detendrá después del minuto y veras que en la celda AA1 esta por ejemplo el numero 2001, y así cada vez que lo ejecutes hasta que llegue a las 5000 filas.

Creo que sería mejor seleccionar las 100,000 filas y dejar que se ejecute la macro durante cierto tiempo, ten en cuenta que cada vez que ejecutes la macro antes debes seleccionar las 100, 000 filas.

.Perdona !. Tuve que ir a comer algo porque sino mi mujer me mata :).

Probaré con todas las filas y le colocaré el tiempo en 5 a ver que tal.

Mientras te quería preguntar: si se va pausando hasta que complete, ¿como sabré que ya terminó?, ¿ revisando al lista a ver si ya salen filas coloreadas al final?. Estuve viendo como colocarle una barra de progreso pero por supuesto no lo logre :S.

Agrega lo siguiente a la primera macro

Antes de <strong style="line-height: 1.5em;">Err.Clear Agrega

Application.StatusBar = "Analizados " & i & " de " & UBound(Datos)

Debe quedar así

Application.StatusBar = "Analizados " & i & " de " & UBound(Datos)
Err.Clear 'Borra cualquier error que haya ocurrido

Antes de Application.ScreenUpdating = True Agrega

Application.StatusBar = False

Debe quedar así

Application.StatusBar = False
Application.ScreenUpdating = True 'Se activa la actualización de la pantalla(para que no se quede como congelada)

Esto es para que en la barra de estado de microsoft Excel se muestre cuantas filas ya se han analizado.

De acuerdo !. Aunque con colocar la AA1 a la vista (esto también se me había olvidado), puedo ver por donde voy. Con respecto a esto la pasé dos veces, la primera vez en 3 mins. llegó a la 49, la segunda vez en 3 mins 46 , AA1 llegó a la 95, si son 100.000, está como demasiado lenta, no crees?, a este paso mas de 100 horas?. No es por desanimarte pero sin colorear (que no me sirve) el Access se tarda unos 2 mins. Luego como te expliqué la diferencia entre filas coincidentes de B es de cientos de miles, no de 10, y hay pares que tienen una diferencia mucho menor después de la 95, que están en el orden de las decenas o cientos. Esto comprobado con la otra Macro. Creo por eso que la decisión numérica no la está ejecutando bien. Ni idea !!!

Pues le coloqué un intervalo mucho mayor y en los mismos 3 min. me dio el mismo resultado, Lo que te puedo decir es que con la Macro ColorearRepetidos en 3 mins. consigue todas las coincidencias en 5.000 filas.

Lo otro que ocurre es que la primera Macro no mueve las filas coloreadas, por lo tanto no deja ningún espacio vacío. No sabiendo si entonces esto influye en algo mas que no funcionar la segunda Macro. Con el tiempo de ejecución estoy pensando si puedo ayudar con algo para que no tarde tanto. Pero aparte de repetir ciertas restas que van necesariamente a estar dentro del mismo intervalo, no se me ocurre nada.

Quiero decir:

10<N<100

B

1 50

2 60

3 70

4 300

5 350

- B1-B2, dentro; B1-B3, dentro; B1-B4, fuera

- Por lo tanto empieza a restar B2-B4 porque B2-B3 debe estar por fuerza dentro del intervalo

Podría esto reducir considerablemente las operaciones pero no se si complicaría demasiado el código y así el tiempo de ejecución.

Por eso ¿podría esto ayudar o complicará mas bien las cosas?

A ver, probé en copiarme 15000 y los coloque en otra Hoja. La hice corre por 3 mins igual y en vez de chequearme 49 llego a 106. Así que le aumente el tiempo a 15 mins. y Llego a 2434. En esta ocasión saco un par y esta cumpliendo con absolutamente todo. Ahora lo que voy a hacer es aumentarle el tiempo a media hora y el intervalo para ver si saca un poco mas. Pero era mas que todo dejarla por mas tiempo. Yo creo amigo que lo lograste, lo de la lentitud que seria quizás colocarle lo de las restas de mas, creo que es demasiado pedir. Lo que es cierto que trabaja mejor si abres un libro nuevo, me pasa también con la otra.

Perdona pero veo el código y no logro darme cuenta, pero por lo lenta que esta la Macro, no será que si son 100000 registros está haciendo la operación de la B1 hasta la B100000 y luego de la B2 hasta la B100000 y así sucesivamente?, y por eso se pone mas rápida al reducir el numero de registros donde debe buscar?. Ahora probé con los mismos 15.000 por 30 mins. aumentando el intervalo, pero se quedó trabada.

Buenos días a18327. Te digo humildemente que gracias a tus explicaciones paso por paso, pude ubicar el condicional para comparar el intervalo y logré corregirlo y ahora funciona como un reloj.

Lo deje solo por 3 mins aumentando el intervalo y me consiguió 51 grupos que cumplen con todo usando el mismo color. Una maravilla !!.

Esto fue lo que cambié:

If ValorMinimoResta <= Math.Abs(Datos(i, ColumnaResta) - Datos(j, ColumnaResta)) <= ValorMaximoResta Then 'Se verifica que el valor absoluto de la resta de la columna resta es decir la numero 2 de la fila i y la columna resta de la fila j sea mayor o igual que el valor mínimo y menor o igual que el valor máximo del rango permitido

Hay un error en la lógica se podría decir pero el programa trabaja sobre ruedas.

La segunda no la probé pero si tu dices que funcional la dejaré así. Y si no funciona, lo importante esta hecho. Well done !! :).

Antes de cerrar la pregunta quería saber si quieres hacer algún comentario adicional. Si no se de ti de hoy a mañana, pues la cierro con todas las gracias que lo adornan.

Admiro mucho el trabajo que hacen y espero que con esto que yo publiqué ayude a alguien de alguna manera también.

Solo te puedo decir que esto ha sido por una causa de una manera completamente altruista, por lo tanto sin remordimiento puedo decir que yo también he colaborado. Aparte del tiempo me he roto la cabeza ;). Pero aparte de todo he aprendido un montón

Muchas Gracias !!

Una opción mas rápida para encontrar las filas duplicadas si ya tienes los datos en access seria conectar Excel con Access extraer las filas repetidas y pegarlas en una hoja y después ir eliminando las filas que no cumplan con la resta. En vez de buscar las filas repetidas dentro de las filas de Excel que tardaría demasiado, se buscaría las filas repetidas en Access lo cual dura 3 minutos según dices, y después en Excel solo se colorearía las filas por grupos y se quitarían las filas que no cumplan la resta, esto para no tener que comparar las 100,000 filas, si no solo se compararían las que estén repetidas (muchas menos filas)

Esto podría ser en otra pregunta. Ya que aunque el problema es el mismo pero la forma de solucionarlo es distinto.

Si amigo comprobado, porque volví a utilizar toda la lista de 100.000 y me sacó en 5 mins solo un par, por alguna razón hay que analizarla por bloques, yo a mano selecciono según la letra del primer apellido ("C") de manera que no me rebase unas 5 mil. Por alguna razón al disminuirle el numero de filas puede analizar con efectividad muchas mas. Pero sino igual lo puedo hacer a mano.