H o l a:
Te anexo el código solamente para las malas
Private Sub CommandButton5_Click()
'Por.Dante Amor
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
Set h3 = Sheets("Hoja3")
cuenta = Application.Count(h2.Columns("A"))
If cuenta < 5 Then
res = MsgBox("Aún no se ha concluido el cuestionario" & vbCr & vbCr & _
"Desea evaluar el cuestionario", vbQuestion + vbYesNo, "CUESTIONARIO")
If res = vbNo Then Exit Sub
End If
'
buenas = 0
malas = 0
k = 2
For i = 1 To h2.Range("A" & Rows.Count).End(xlUp).Row
preg = h2.Cells(i, "A")
Set b = h1.Columns("A").Find(preg)
If Not b Is Nothing Then
correcta = True
'
n = 2
For j = b.Row + 2 To h1.Range("B" & Rows.Count).End(xlUp).Row
If h1.Cells(j, "A") <> "" Then Exit For
If h1.Cells(j, "C") <> h2.Cells(i, n) Then
correcta = False
End If
n = n + 1
Next
'
If correcta Then
buenas = buenas + 1
Else
malas = malas + 1
n = 2
h3.Cells(k, "A") = h1.Cells(b.Row, "B")
filapreg = k
k = k + 1
h3.Cells(filapreg, "A").Interior.ColorIndex = 4
For j = b.Row + 2 To h1.Range("B" & Rows.Count).End(xlUp).Row
If h1.Cells(j, "A") <> "" Then Exit For
h3.Cells(k, "A") = h1.Cells(j, "B")
h3.Cells(k, "B") = h1.Cells(j, "C")
h3.Cells(k, "C") = h2.Cells(i, n)
k = k + 1
If h1.Cells(j, "C") <> h2.Cells(i, n) Then
correcta = False
h3.Cells(filapreg, "A").Interior.ColorIndex = 3
End If
n = n + 1
Next
End If
'
End If
k = k + 1
Next
With UserForm2
.buenas = buenas
.malas = malas
.Show
End With
'
End Sub
S a l u d o s . D a n t e A m o r.