Ir ao conteúdo
  • Cadastre-se

Excel Concatenar se a linha tiver o mesmo código


Ir à solução Resolvido por Basole,

Posts recomendados

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!

 

Link para o comentário
Compartilhar em outros sites

  • Solução

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

.

 

 

  • Obrigado 1
Link para o comentário
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisa ser um usuário para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...