Encontrar el número de diferencias

Visor · el 22 de julio

Saludos amigos del foro, como se podría encontrar el numero de diferencias que hay en los datos entre una columna y otra?

En la columna Test constaran los aciertos o los fallos con respecto a la col Ref, en este caso me gustaría encontrar el numero de fallos o diferencias

y se pueda ver en la celda F6

Teniendo este dato ya podría calcular el porcentaje de acierto o fallo y mostrarlo en otras celdas

Subo el archivo para que lo vean

Gracias de antemano

Numero de Diferencias.xlsm

Dr Hyde · el 22 de julio

usa este codigo

Sub diferencias()
Set datos = Range("d5").CurrentRegion
Set datos = datos.Offset(1, 0).Resize(datos.Rows.Count - 1, datos.Columns.Count)

For Each fila In datos.Rows
nf = fila.Row - datos.Row + 1
f = fila
If f(1, 1) <> f(1, 2) Then a = a + 1
Next fila

Range("f6") = a
With Range("g6")
.Value = a / datos.Rows.Count
.NumberFormat = "0.00%"
With .Font
.Size = 16
.Bold = True
End With
End With

End Sub

Visor · el 23 de julio

Gracias Dr. Hyde

Funciona en el archivo ejemplo sin mas datos alrededor, pero,... porque no funciona cuando tiene mas datos alrededor, mira esta imagen.

Creo que el código toma en cuenta algo mas.

He duplicado tu código para que muestre los aciertos cambiando lo <> por = y las letras variables como lo menciono me funciona bien sin datos alrededor. pero así como esta en la imagen no funciona.

Como puedes ver hay 9 diferencias y 3 aciertos, pero el resultado muestra 3 diferencias y 12 aciertos.

Te pongo el codigo completo que use

Sub Resultado()
Diferencias
Aciertos
End Sub
Sub Diferencias()
Set datos = Range("D5").CurrentRegion
Set datos = datos.Offset(1, 0).Resize(datos.Rows.Count - 1, datos.Columns.Count)
For Each fila In datos.Rows
    nf = fila.Row - datos.Row + 1
    f = fila
    If f(1, 1) <> f(1, 2) Then d = d + 1
Next fila

Range("G6") = d
With Range("H6")
    .Value = d / datos.Rows.Count
    .NumberFormat = "0.00%"
    With .Font
        .Size = 16
        .Bold = True
    End With
End With
End Sub
Sub Aciertos()
Set datos = Range("D5").CurrentRegion
Set datos = datos.Offset(1, 0).Resize(datos.Rows.Count - 1, datos.Columns.Count)
For Each fila In datos.Rows
    nf = fila.Row - datos.Row + 1
    f = fila
    If f(1, 1) = f(1, 2) Then a = a + 1
Next fila

Range("G7") = a
With Range("H7")
    .Value = a / datos.Rows.Count
    .NumberFormat = "0.00%"
    With .Font
        .Size = 16
        .Bold = True
    End With
End With
End Sub

Como puedes ver todo esta como me lo has indicado, algo pasa

logroastur · el 23 de julio

Buenas @Visor

Utiliza (en combinación con el formato[en la anterior pregunta])

Sub Comparar()
    Dim ultimo  As Long
    Dim c       As Long
    Dim n       As Long
    Dim v       As Long
    Dim strNull As String
    Dim strMSG  As String
    ultimo = Hoja1.Range("E6").End(xlDown).Row
    c = ultimo - 5
    For i = 6 To ultimo
        If Hoja1.Range("D" & i) <> Hoja1.Range("E" & i) Then
            Hoja1.Range("E" & i).Interior.Color = vbYellow
            Hoja1.Range("E" & i).Font.Color = vbRed
            strNull = strNull & vbTab & Format(i - 5, "000") & "º: .......    " & Hoja1.Range("D" & i).Value & vbNewLine
            n = n + 1
        Else
            Hoja1.Range("E" & i).Interior.Color = xlNone
            Hoja1.Range("E" & i).Font.Color = vbBlack
            v = v + 1
        End If
    Next i
    
    strMSG = "De " & c & " preguntas se logro el siguiente resultado " & vbNewLine & vbNewLine & _
             IIf(n > 0, "Errores : " & vbNewLine & vbTab & n & " que es el " & Format(n / c, "Percent") & vbNewLine & vbNewLine, "") & _
            "Aciertos : " & vbNewLine & vbTab & v & " que es el " & Format(v / c, "Percent")
    MsgBox strMSG, vbInformation, "TEST"
    If n > 0 Then
        MsgBox "Respuestas erroneas a las preguntas : " & vbNewLine & vbNewLine & strNull, vbInformation, "TEST"
    End If
End Sub

Un saludo

Visor · el 23 de julio

Gracias Logroastur este apoyo no solo es a mi, sino tambien a la ciencia de la enseñanza de la microbiologia.

Lo que me pregunto es porque si capta bien que son 12 preguntas, al final solo me muestra 11???

Sera que el marco del Msgbox es muy pequeño y lo tapa??? al ultimo numero

Sin embargo cuando aumento un parametro mas para analizar (una fila siguiente) serian 13, alli me muestra el 13 pero no el 12

....10°,11°,13°

Dr Hyde · el 23 de julio

lo hice basandome en la informacion que subiste, con esta nueva informacion la amcro queda asi

Numero de Diferencias (1).xlsm

Visor · el 23 de julio

Gracias Dr. Hyde, al final queda una sombra, como debo hacer que se elimine automaticamente

Sera con un select a una celda nada mas o es mas apropiado otra codigo

Dr Hyde · el 23 de julio

se me paso quitarle un select en el codigo, esta en las primeras lineas, solo borra esa linea y listo

datos.Select, esta instruccion es la que debes borrar para quitar la sombra, si la siguies viendo solo entra a la hoja yda click sobre cualquier celda para que se borre (la sombra)

Visor · el 24 de julio

Saludos,

Encontré un defecto,.. si en la columna A , desde la Celda A6 hasta la A17 le pongo numeración 1.....12, la macro no funciona solo hace una cuenta del total de items y coloca 100%

sera posible evitar que suceda esta situación, pues me gustaría ir numerando cada item de prueba en la realidad pueden ser 300 o mas.

Dr Hyde · el 24 de julio

checa esta macro, si añades informacion a la derecha o a la izquierda de las columnas D y E, la macro solo se enfocara en las columnas D y E, te puse un select para que veas las columnas que considera la macro, ahora la cantidad de columnas o filas dependera de que tantas quieras usar.

Sub diferencias()
Set datos = Range("b2").CurrentRegion
Set funcion = WorksheetFunction

blancos = funcion.CountBlank(datos.Columns(1))
Set info = Range("D6").Resize(datos.Rows.Count - blancos, 2)
info.Select '<------- esta linea la puedes borrar

For Each FILA In info.Rows
F = FILA
If F(1, 1) <> F(1, 2) Then A = A + 1
Next FILA

Range("F6") = A
End Sub

Numero de Diferencias (1).xlsm

Visor · el 24 de julio

Siiii!! Ahora todo esta bien no hay fallas le coloque el porcentaje con el grabador de macros usando el resultado en las celdas con eso de colocar formulas

Estimado Logroastur ya comprendí lo de los resultados en los Msgbox lo usare para previo resultado y lo que se muestre en las celdas sera lo de Dr. Hyde

Gracias a los dos

Ahora funciona bien, empezare a añadir los 300 items para echarlo a correr

Tema solucionado