Repetición de valores por fila
Necesitaria uma macro para encontar la repeticion o coincidencias de los valores de 6 celdas por fila, el rango seria ejemplo A1:F100
Y el resultado ejemplo en H de los números repetidos y en I las veces de estos.
1 Respuesta
No se entiende bien lo que quieres y no veo la imagen que mencionas, ¿la repeticon es con respecto a otras filas o bien con los números de esa misma fila?
El resultado esperado seria en hoja RESULTADO OK.
Se repiten 2 veces 3 números resultado a mano 14,17,42/23, 27,38 y 23,27,36
Una imagen más que mil palabras
Pues este es el resultado de la macro, trate de hacerlo lo ms sencillo posible ya que lo que pides es algo difícil de programar
y esta es la macro
Sub ejecuta()
filtra_repetidos
armar_combinaciones
compara
filtraryborrar
End Sub
Sub filtra_repetidos()
Dim unicos As New Collection
Set datos = Range("c5").CurrentRegion
Range("i:p").Clear
With datos
cuenta = .Cells.Count
For i = 1 To cuenta
numero = .Cells(i)
On Error Resume Next
unicos.Add numero, CStr(numero)
On Error GoTo 0
Next i
For j = 1 To unicos.Count
Range("j5").Cells(j, 1) = unicos.Item(j)
Next j
With Range("j5").CurrentRegion
.Sort key1:=Range(.Columns(1).Address), order1:=xlAscending
.Name = "tabla"
End With
.Name = "numeros"
End With
Set datos = Nothing: Set unicos = Nothing
End Sub
Sub armar_combinaciones()
Set tabla = Range("tabla")
With tabla
filas = .Rows.Count
comb = WorksheetFunction.Combin(filas, 3)
Set tabla2 = Range("l5").Resize(comb, 3)
matriz = tabla2
x = 1
For i = 1 To filas
For j = 1 To filas
For k = 1 To filas
If k > j And j > i Then
matriz(x, 1) = tabla.Cells(i)
matriz(x, 2) = tabla.Cells(j)
matriz(x, 3) = tabla.Cells(k)
x = x + 1
End If
Next
Next
Next
End With
With tabla2
Range(.Address) = matriz
.EntireColumn.AutoFit
.Name = "combinaciones"
End With
Erase matriz
Set tabla = Nothing: Set tabla2 = Nothing
End Sub
Sub compara()
Set tabla = Range("combinaciones")
Set tabla2 = Range("numeros")
With tabla
filas = .Rows.Count
filas2 = tabla2.Rows.Count
For i = 1 To filas2
For j = 1 To filas
numero = .Cells(j, 1)
numero2 = .Cells(j, 2)
numero3 = .Cells(j, 3)
cuenta = WorksheetFunction.CountIf(tabla2.Rows(i), numero)
cuenta1 = WorksheetFunction.CountIf(tabla2.Rows(i), numero2)
cuenta2 = WorksheetFunction.CountIf(tabla2.Rows(i), numero3)
suma = Application.Sum(cuenta, cuenta1, cuenta2)
.Cells(j, 4) = suma
Next j
Next i
.CurrentRegion.EntireColumn.AutoFit
.CurrentRegion.Name = "combinaciones"
End With
Set tabla = Nothing: Set tabla2 = Nothing
End Sub
Sub filtraryborrar()
Set tabla = Range("combinaciones")
With tabla
.Sort key1:=Range(.Columns(4).Address), order1:=xlDescending
cuenta = WorksheetFunction.CountIf(.Columns(4), 1)
indice = WorksheetFunction.Match(1, .Columns(4), 0)
.Rows(indice).Resize(cuenta).Clear
End With
Range("tabla").Resize(, 2).EntireColumn.Delete
Set tabla = Nothing
End Sub
Solo cambia las líneas c5 por A1 de la macro filtrar repetidos, y si quieres también la j5 para adaptarlas a tus datos
