Olá caros leitores.

Já recebi vários pedidos de ajuda de usuários do Excel com a necessidade de mesclar valores de mais de uma tabela para uma nova lista que recebesse o conteúdo de ambas mas de forma que estes valores não viessem repetidos. Ou seja, era imperativo listar tudo que estivesse na planilha 1, por exemplo, e também na planilha 2, porém, os valores que fossem iguais, só deveriam ser listados uma vez.

Sei que esta ainda é uma dificuldade de muitas pessoas, por isso, hoje vou escrever a respeito disso. Espero que gostem deste artigo.

Para o exemplo que vamos trabalhar hoje, imaginemos a situação:

Plan1 – Contém uma listagem dos alunos do curso de Excel no turno da manhã.

Plan2 – Contém uma listagem dos alunos do curso de Excel no turno da noite.

As duas planilhas têm o mesmo formato e disposição das colunas. São elas:

Coluna A – Nome do Aluno

Coluna B – Sobrenome do Aluno

Coluna C – Idade do Aluno

Vamos criar a Plan3 para exibirmos a nossa lista de resultado com valores agrupados.

Vamos criar nosso código acessando o ambiente VBA (ALT + F11).

Insira um módulo ao projeto e crie uma sub-rotina chamada MergeDistinct e coloque o código abaixo descrito.

A rotina pode ser chamada normalmente como a uma macro comum. Menu Ferramentas > Macro > Macros… (ALT + F8) e mandar executar a macro MergeDistinct.

Sub MergeDistinct()

Dim R As Range
Dim LastCell As Range
Dim WS As Worksheet
Dim N As Long
Dim M As Long
Dim StartList1 As Range
Dim StartList2 As Range
Dim StartOutputList As Range
Dim ColumnToMatch As Variant
Dim ColumnsToCopy As Long

' Nesta coluna estão os valores que serão comparados no teste
ColumnToMatch = "C"

' Número de colunas que serão copiadas a partir da coluna de comparação
ColumnsToCopy = 1

' A lista gerada inicia nesta célula.
Set StartOutputList = Worksheets("Plan3").Range("A1")

' A primeira lista a ser mesclada inicia aqui.
Set StartList1 = Worksheets("Plan1").Range(ColumnToMatch & "1")

Set WS = StartList1.Worksheet
With WS
M = 1
' Retorna a última célula usada nesta planilha.
Set LastCell = .Cells(.Rows.Count, StartList1.Column).End(xlUp)
' Loop para comparar os valores
For Each R In .Range(StartList1, LastCell)
If R.Value <> vbNullString Then
N = Application.CountIf(StartOutputList.Resize(M, 1), _
R.EntireRow.Cells(1, ColumnToMatch).Text)
' Se N = 0, então o item ainda não foi colocado na nova lista
' então será copiado. Se N > 0, nós já o listamos
' e não faremos mais nada.
If N = 0 Then
StartOutputList(M, 1).Resize(1, ColumnsToCopy).Value = _
R.Resize(1, ColumnsToCopy).Value
' M é o número de linhas da lista agrupada. É incrementado neste loop.
M = M + 1
End If
End If
Next R
End With

' A segunda lista a ser mesclada inicia aqui.
Set StartList2 = Worksheets("Plan2").Range(ColumnToMatch & "1")
Set WS = StartList2.Worksheet
With WS
Set LastCell = .Cells(.Rows.Count, StartList2.Column).End(xlUp)
For Each R In .Range(StartList2, LastCell)
If R.Value <> vbNullString Then
N = Application.CountIf(StartOutputList.Resize(M, 1), _
R.EntireRow.Cells(1, ColumnToMatch).Text)
If N = 0 Then
StartOutputList(M, 1).Resize(1, ColumnsToCopy).Value = _
R.Resize(1, ColumnsToCopy).Value
M = M + 1
End If
End If
Next R
End With

End Sub

 
Para baixar o arquivo de exemplo, clique no link abaixo, no final dessa matéria.

Espero que tenham gostado.

Um abraço.

Créditos: Esse código foi adaptado do original desenvolvido por Chip Pearson
www.cpearson.com/Excel/MergeListsToDistinct.aspx

Antes de efetuar o download do arquivo de exemplo, convido você a socializar conosco.

Escolha uma das opções abaixo. Seguir no twitter, assinar nossa Newsletter...

Isso nos ajuda na divulgação do site e te permite ficar sempre atualizado das novidades. Fico muito grato pela sua colaboração.

Digite seu email:

Você receberá um email para ativar o cadastro, ok!