Excel Concatenar se a linha tiver o mesmo código

[Elaine]

Olá,
estou pesquisando há algum tempo e não consegui montar uma solução sozinha.

Tenho uma tabela onde uma coluna só apresenta nomes e numa outra apenas códigos referentes à moradia das pessoas. Preciso formar uma nova coluna com esses nomes concatenados, a partir de um código comum que eles possuem.

Exemplo:

 

Nome         código                               (nova coluna) nomes

Manoel       35102030040080248         Manoel, Pedro, Joaquim, Maria

Pedro         35102030040080248

Joaquim     35102030040080248

Maria          35102030040080248

Julia            35102030040080252

Leonardo    35102030040080252

 

se alguém puder dar um help, agradeço demais!

 

[deciog]

@Elaine , Boa tarde.

 

O ideal é postar um modelo assim conferimos o tipo que esta formatado as células e depois sim fazer a formula

 

Nota os numero que aparece tem 17 carácter e se for numero o Excel só aceita 15 carácter

 

Decio

 

[Elaine]

@deciog , boa tarde

adicionei um modelo dos dados que estou mexendo.

 

Não sabia dessa informação! Obrigada! Nos meus arquivos o campo código está em geral

modelo.xlsx

[Basole]

Segue opcao com macro.

Veja se e isso que deseja.

 

Sub Concatenar_linha_tiver_o_mesmo_código()
    Dim ws1    As Worksheet
    Dim i      As Long
    Dim Lr     As Long
    Dim sNom   As String
    Dim end1   As Range
    Dim end2   As Range
    Dim cell   As Range
    Dim arr()  As String
    Dim tmp    As String
    
    Set ws1 = ThisWorkbook.Sheets("Plan1")

    With ws1
    Lr = .Range("A" & .Rows.Count).End(xlUp).Row
     
    For Each cell In .Range("A2:A" & Lr)
      If (cell <> "") And (VBA.InStr(tmp, cell) = 0) Then
        tmp = tmp & cell & "|"
      End If
    Next cell

If VBA.Len(tmp) > 0 Then tmp = VBA.Left(tmp, VBA.Len(tmp) - 1)

arr = VBA.Split(tmp, "|")

        For i = 0 To UBound(arr)
            Set end1 = .Columns(1).Find(What:=arr(i), _
                        LookIn:=xlValues, LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                        MatchCase:=False, SearchFormat:=False)

            If Not end1 Is Nothing Then
                Set end2 = end1
                sNom = sNom & "," & VBA.Trim(end1.Offset(, 1).Value)

                Do
                    Set end1 = ws1.Columns(1).FindNext(After:=end1)

                    If Not end1 Is Nothing Then
                        If end1.Address = end2.Address Then Exit Do
                        sNom = sNom & "," & VBA.Trim(end1.Offset(, 1).Value)
                    Else
                        Exit Do
                    End If
                Loop
            End If

            If sNom <> "" Then
                .Range("F" & i + 2).Value = VBA.Mid(sNom, 2)
                sNom = ""
            End If
        Next i
    End With
End Sub

.

 

 

[Elaine]

@Basole Nossa, é exatamente o que eu precisava!!! Muito obrigada mesmo, me poupou uns dias de trabalho manual!!

[deciog]

@Elaine , Boa Tarde

 

Desculpa a demora estava dando suporte ao cliente

 

Fiz com formulas, Confere

 

Link   https://www.sendspace.com/file/h7etlb

 

Se foi útil clica no curtir,na mãozinha, é uma forma de agradecimento pela ajuda
 
Decio