Visual Basic em Português

Quando falamos em vários registos, falamos muitas vezes em registos duplicados. A forma usual de os eliminarmos é ordenando a lista e escolher, visualmente ou através de algumas fórmulas, os registos a apagar.

Mas existem maneiras mas simples e mais práticas de o fazer, especialmente se a lista for muito grande, usando o VBA

Neste exemplo será usando um Dictionary do Microsoft Scripting Runtime que será inserido como referência. A principal vantagem de usar este objecto, é que permite pesquisar por um valor na sua colecção através de um simples método Exists(). Isto permite que se faça um ciclo em toda a lista, verifique-se se o registo já existe ou não, e caso exista indicar esse registo para apagar. Finalmente, caso o registo não exista na lista, adiciona-se.

É um processo muito mais simples e prático do que o recurso a arrays.

Para este exemplo, foi indicado que a lista a verificar seria a selecção actual, sem limite de linhas ou colunas. Caso seja necessário, pode-se alterar por uma área(range) fixa, substituindo:

      For Each rng In Selection

pela área (range) que pretendemos verificar, como por exemplo:

      For Each rng In Range("B5:D14")

Para implementar este pequeno exemplo é necessário abrir o editor de VBA (ALT+F11) e colocar este código associado a um botão. No editor é necessário adicionar a referência ao nosso objecto através do menu Tools –> References seleccionando depois o Microsoft Scripting Runtime.

Para testar é só seleccionar a área a verificar/apagar os registos e correr o código usando o botão.

Sub DeleteDuplicates() 

    Dim msg As String
    msg = "Deseja apagar os registos duplicados na selecção ?"

   ' Confirma a intenção de continuar
   If MsgBox(msg, vbYesNo + vbQuestion + vbDefaultButton2) = vbYes Then

        Dim rng AsRange, rngDelete AsRange
        Dim dic As New Dictionary
        Dim tmpString As String
        Dim x As Byte

       Application.ScreenUpdating = False

        For Each rng In Selection

            tmpString = ""

           ' Faz um ciclo em todas as colunas seleccionadas
            ' da linha actual e guarda na variável "tmpString"
           Forx = 1 ToSelection.Columns.Count
                tmpString = tmpString & rng.Columns(x).Value & "|"
           Next x

            ' Caso não esteja em branco
           If tmpString <> vbNullString Then

               ' Verifica se está no Dictionary
               If dic.Exists(tmpString) Then

                   ' Adiciona a célula ao range a apagar
                   If Not rngDelete Is Nothing Then
                        rngDelete = Union(rngDelete, rng)
                    Else
                       rngDelete = rng
                    End If

                Else

                   ' Adiciona a string e a linha
                   dic.Add(tmpString, rng.Row)

                End If

            End If

        Next

       ' Caso exista alguma coisa a apagar
       If Not rngDelete Is Nothing Then 
           rngDelete.EntireRow.Delete 
        End If

       Application.ScreenUpdating = True
       dic = Nothing

    End If

End Sub

 
Este exemplo mostra como eliminar registos duplicados, mas através do código apresentado é simples alterar para apenas indicar (colorir por exemplo) os registos que se encontram iguais.

Para que possam testar e modificar o exemplo aqui apresentado, podem descarregar este exemplo: DOWNLOAD

PS: Como sempre, qualquer dúvida, comentário ou correcção ao artigo é sempre bem vinda!