Este fórum está sendo desativado

[edsondouglas]

Eu preciso comparar duas listagens de nomes no Excel. Uma é de nomes cadastrados no Active Directory e a outra é de funcionários. Preciso que de alguma forma o Excel mostre se houver nomes parecidos com a listagem que foi procurada, pois quando alguns funcionários foram cadastrados no Active Directory não foram incluídos seus nomes completos.

Resumindo, eu quero que após comparar os nomes, o Excel apresente em uma nova coluna
todas as ocorrências de um determinado nome.

Ex: Planilha AD aparece o nome “José Silva”. Preciso que após cruzar os dados com a planilha do RH apareçam em uma nova coluna qualquer ocorrência como “José Denoite Silva”, “José Danilo Silva”, “José Gentili Silva”.
São 12 mil nomes para comparar.

[alexandrevba]

Boa tarde!!

Talvez não resolva (seria melhor postar seu arquivo modelo), mas minimiza.

Considerando que o nome e ultimo sobre nome será usado...
nome RH nome AD
alevba teste1 teste2 alevba teste2
maria rosario da silva rosario silva

Tente

Código: Selecionar todos

=SE(CONT.SE($A$2:$A$9;"*"&ESQUERDA(B2;LOCALIZAR(" ";B2)-1)&"*")+CONT.SE($A$2:$A$9;"*"&DIREITA(B2;LOCALIZAR(" ";B2)-1)&"*")>0;1;0)

Att

[Parkeless]

Realmente, sem ver a planilha fica difícil... de qualquer forma, pela sua descrição bolei alguma coisa, vê se funciona aí.

Obs.: 1. Não considera acentos (João # Joao).
[edição] 2. Dependendo da quantidade de dados, o código pode ser bem demorado (pois verifica célula por célula, palavra por palavra). Se você rodar com 2 intervalos de 12.000 linhas cada, vai demorar muito.

Código: Selecionar todos

Sub Parkeless()
Dim Área_completo As Range
Dim Área_incompleto As Range
Dim cell As Range
Dim cell_completa As Range
Dim cell_texto As Variant
Dim cell_texto_completo As Variant
Dim campo As String
Dim i As Integer, i_completo As Integer
Dim semelhante As Integer
Dim critérios As Integer


'Definições do usuário
Set Área_incompleto = Application.InputBox("Selecione os nomes incompletos (pode ser coluna inteira).", "Dados Incompletos", Type:=8)
Set Área_completo = Application.InputBox("Selecione os nomes completos (pode ser coluna inteira).", "Dados Completos", Type:=8)
critérios = Application.InputBox("Número de critérios (recomendado:2)", "Critérios", 2)

Application.ScreenUpdating = False

'Definir área de análise
Application.Worksheets.Add
Área_incompleto.Copy Range("A1")

'Para cada nome incompleto
For Each cell In Range("A:A").SpecialCells(xlCellTypeConstants)
    cell_texto = Split(cell, " ")
        
    'Fazer para cada nome completo
    For Each cell_completa In Área_completo.SpecialCells(xlCellTypeConstants)
        cell_texto_completo = Split(cell_completa, " ")
               
        'Para cada palavra na célula incompleta
        For i = 0 To Application.CountA(cell_texto) - 1
            'Ignorar até 3 letras (do, das, dos, das, etc)
            If Len(cell_texto(i)) > 3 Then
                
                'Para cada palavra na célula completa
                For i_completo = 0 To Application.CountA(cell_texto_completo) - 1
                    'Se for igual, somar um 'semelhante'
                    If StrConv(cell_texto(i), vbProperCase) = StrConv(cell_texto_completo(i_completo), vbProperCase) Then: semelhante = semelhante + 1
                Next i_completo

            End If
            
        Next i
            
            'Se palavras semelhantes somaram duas, marcar o nome completo na próxima coluna disponível
            If semelhante >= critérios Then
                cell.Offset(0, Application.CountA(cell.EntireRow)) = cell_completa
            End If
            'Zerar

            'Próxima palavra completa

            semelhante = 0
            Next cell_completa
    
jump:
semelhante = 0
Next cell

Rows("1:1").Insert
Range("A1") = "Nome Incompleto"
Range("B1") = "Variações"


Columns("A:ZZ").EntireColumn.AutoFit

Application.ScreenUpdating = True

MsgBox "Relatório concluído!", vbInformation



End Sub