Eliminar linhas duplicadas comparando 2 linhas e 2 colunas

[jomamata]

Boa tarde

Pretendo apagar neste ficheiro todas as linhas com referência e valores duplicados.

Para isso tenho que criar 2 condições que são: serem iguais na coluna F e ao mesmo tempo serem iguais entre si nas colunas G e H.

Quem pode ajudar?

Envio ficheiro para facilitar a compreensão

http://www.sendspace.com/file/2o51o0

[XFlaPc]

Não estou entendendo essa condição, pela lógica que você falou daria no mesmo de ser apenas 1 condição: ter os valores F=G=H.

Explique melhor.

[zinhovba]

Boa noite!!!

Faça um teste...

Sub dupl()
    Dim myrow As Integer, _
    myValue As String, _
    myRef As Integer
    For myrow = 2 To Range("A1").End(xlDown).Row
         '        If Cells(myrow, 6) = Cells(myrow + 1, 6) And Cells(myrow, 7) = Cells(myrow + 1, 8) And Cells(myrow, 8) = Cells(myrow + 1, 7) Then
         '            Call myDel(myrow, myrow + 1)
         '            mr = 1
         '        Else
         '            If Cells(myrow, 6) = Cells(myrow + 2, 6) And Cells(myrow, 7) = Cells(myrow + 2, 8) And Cells(myrow, 8) = Cells(myrow + 2, 7) Then
         '                Call myDel(myrow, myrow + 2)
         '                mr = 1
         '            Else
        If Cells(myrow + 2, 6) = Cells(myrow + 1, 6) And Cells(myrow + 2, 7) = Cells(myrow + 1, 8) And Cells(myrow + 2, 8) = Cells(myrow + 1, 7) Then
            Call myDel(myrow + 1, myrow + 2)
            mr = 1
        End If
         '            End If
         '        End If
        If Cells(myrow, 6) = "" Then Exit For
        myrow = myrow - mr
        mr = 0
    Next myrow

End Sub
Function myDel(myrow, myrow1)
    Rows(myrow1 & ":" & myrow1).Delete Shift:=xlUp
    Rows(myrow & ":" & myrow).Delete Shift:=xlUp
End Function

[Visitante]

Sub ExcluiLinRep()
Dim LR, i As Long
LR = Cells(Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = False
    For i = LR To 2 Step -1
        If Cells(i, "F") = Cells(i - 1, "F") And _
            Cells(i, "H") = Cells(i - 1, "G") Then
                Rows(i - 1).EntireRow.Delete
                Rows(i - 1).EntireRow.Delete
            i = i - 1
        End If
    Next i
Application.ScreenUpdating = True
End Sub

[jomamata]

Bom dia e obrigado a todos que me ajudaram ou tentaram ajudar. Qualquer das 2 últimas soluções me resolve o problema, mas já agora, e peço desculpa por ser chato, não será possível ir mais longe e fazer aquilo que sugiro no ficheiro que envio?

Seria ouro sobre azul, era essa a solução completa.

Obrigado mais uma vez a todos.

http://www.sendspace.com/file/ci1jay