Funcion eficiente para búsqueda de duplicados y coincidencias e Arrays

[Bazooka]

Hola amigos ando medio enroscado con esto:

Tengo un array bastante grande pero lo haré de 3 elementos:

Siempre carga números entre el 0 y el 99 separados por comas

Dim Dato (1 to 3) as String

Dato(1) = "1,2,3"
Dato(2) = "4,5,6"
Dato(3) = "1,3,5"

Bien ahora necesitaría una función que verifique entre todos los miembros si no hay ninguna secuencia igual ( o casi igual) y con un parametro que sea Concordancia que establece la cantidad máxima de cooncordancia entre cada item de la variable.
Segun el ejemplo cada miembro de la matriz no podria tenes más de 2 digitos iguales cada una lo que segun el ejemplo no se cupliria entre el 1º y el 3º valor del ejemplo ya que tienen el 1 y el 3...

Ah y la funcion devolvería la cantidad iten que no cumplieron la condicion!!!

Código: [Seleccionar]

Private Sub Command2_Click()
Dim Dup As Integer

Dup = VerificarDuplicados(2)

MsgBox "Se han encontrado " & Dup & " duplicados"
End Sub

Private Function VerificaDuplicados(Cooncordancias As Byte) As Integer
Dim n
For n = 1 To UBound(datos())
'    ...
Next
End Function

Ojalá me ayudan por favor por que la hice y la reize y no me sale!!!!

[LeandroA]

Hola, no me queda claron en algunos casos, porque un valor puede concordancia con tres item y a la vez uno de esos item tambien puede tener concordancia con otros 5 y esto suma unos cuantos, fijate esta funcion y quizas te da para modificarla a tu necesidad

Código: (Vb) [Seleccionar]

Option Explicit
Dim Dato(1 To 8) As String

Private Function VerificarDuplicados(Cooncordancias As Byte) As Long
    Dim i As Long, J As Long, X As Long, Y As Long
    Dim s1() As String, s2() As String
    Dim Cont As Long
    Dim Acum As Long
   
    For i = LBound(Dato()) To UBound(Dato()) - 1
       
        s1 = Split(Dato(i), ",")
        For J = i + 1 To UBound(Dato())
            Cont = 0
            s2 = Split(Dato(J), ",")
            For X = 0 To UBound(s1)
                For Y = 0 To UBound(s2)
                    If s1(X) = s2(Y) Then
                        Cont = Cont + 1
   
                    End If
                Next
            Next
            If Cont >= Cooncordancias Then
                VerificarDuplicados = VerificarDuplicados + 1
                Exit For
            End If
        Next
    Next
End Function

Private Sub Form_Load()
    Dato(1) = "9,2,8"
    Dato(2) = "4,5,6"
    Dato(3) = "7,8,9"
    Dato(4) = "9,10,11"
    Dato(5) = "12,13,14"
    Dato(6) = "15,16,17"
    Dato(7) = "18,13,12"
    Dato(8) = "21,22,23"
   
    Dim Dup As Long
   
    Dup = VerificarDuplicados(2)
   
    MsgBox "Se han encontrado " & Dup & " duplicados"
End Sub
sino pone otros ejemplos y cuantas concordancias ves

[Bazooka]

Hola, no me queda claron en algunos casos, porque un valor puede concordancia con tres item y a la vez uno de esos item tambien puede tener concordancia con otros 5 y esto suma unos cuantos, fijate esta funcion y quizas te da para modificarla a tu necesidad

Gracias Leandro por tu respuesta:

La idea es que si decimos que la cooncordancia es 2 no debiera haber ninguna combinación en la matriz que tuviera mas de 2  números en comun entre una y otra cualquiera.

Siguiendo este ejemplo  si el 1º valor de la matriz es:
Dato(1) = "1,2,3,4"  y el factor de cooncordancia es 2 , en ninguna de los demas valores de la matriz debiera haber una que contenga el 1 , 2 y 3 ,  1, 3 y 4 ,  1, 2 y 4 , ............ por que habria más de 2 iguales que en la 1º.

Ahora voy a probar tu ejmplo y luego te digo
.

[Bazooka]

GRANDE LEANDRO!!

Funciona perfecto lo que me hiciste sólo le quite el signo = a la linea :
If Cont >= Cooncordancias Then .
Tambien le agregue una variable que guarda la linea o indice que esta el valor que no cumple la concoordancia para despues modificarlo.

acá copio como quedo corregido:

Código: [Seleccionar]

Option Explicit
Dim Dato(1 To 8) As String
Dim LineasDuplicadas() As Long

Private Function VerificarDuplicados(Cooncordancias As Byte) As Long
    Dim i As Long, J As Long, X As Long, Y As Long
    Dim s1() As String, s2() As String
    Dim Cont As Long
    Dim Acum As Long
   
    For i = LBound(Dato()) To UBound(Dato()) - 1
       
        s1 = Split(Dato(i), ",")
        For J = i + 1 To UBound(Dato())
            Cont = 0
            s2 = Split(Dato(J), ",")
            For X = 0 To UBound(s1)
                For Y = 0 To UBound(s2)
                    If s1(X) = s2(Y) Then
                        Cont = Cont + 1
   
                    End If
                Next
            Next
            If Cont > Cooncordancias Then
                ReDim Preserve LineasDuplicadas(VerificarDuplicados)
                LineasDuplicadas(VerificarDuplicados) = J
                VerificarDuplicados = VerificarDuplicados + 1
                Exit For
            End If
        Next
    Next
End Function
 
Private Sub Command1_Click()
VerificarDuplicados
End Sub

Private Sub Form_Load()
    Dim n
    Dato(1) = "9,2,8,14"
    Dato(2) = "7,5,6,45"
    Dato(3) = "9,90,8,23"
    Dato(4) = "4,5,6,74"
    Dato(5) = "9,10,11,12"
    Dato(6) = "74,6,93,5"
    Dato(7) = "18,13,12,35"
    Dato(8) = "21,22,23,77"
   
    Dim Dup As Long
   
    Dup = VerificarDuplicados(2)
   
    If UBound(LineasDuplicadas) >= 0 Then
        For n = 0 To UBound(LineasDuplicadas)
            Debug.Print "Linea que no cumple cooncordancia: " & LineasDuplicadas(n)
        Next
    End If
End Sub
Según esta ese ejemplo devuelve que el indice 6 no cumple la verificacion de concordancia (con el indice 4 comparten 3 numeros en comun)
.
Creo que para mejorarla del todo habria que hacer que la función devuelva la matriz de lineas que no cumplen en vez de hacerlo en una variable global y que si no hay ningun valor da un error 9 y no se como hacer ninguna de esta cosas.!!