Ir ao conteúdo
  • Cadastre-se
jeffersondaluza

Excel RESOLVIDO Macro concatenar com loop

Recommended Posts

Caros, bom dia!

 

Estou com um problema pra resolver aqui no trabalho.

Seguinte: a tabela abaixo está nesse formato para umas 500 linhas. Eu preciso mesclar as linhas que estão sem contorno pra uma só, a primeira de cada contorno. 

A coluna B tem sempre o primeiro dado preenchido, imagino que isso facilite na contagem do loop. Pensei em contar as células vazias até achar uma com dado, daí concatena as células da coluna C para a primeira e depois apago as linhas vazias. Só não sei fazer isso com a macro. ='(

Alguém pode ajudar? Saudações!

 

teste_concat.JPG.ae1f136c164198b982f3a0115ecb18b0.JPG

 

 

[EDIT] Preciso que fique assim:

 

2teste_concat.JPG.8cd5c468282881708f8a7cd2b8f9d7b3.JPG

Compartilhar este post


Link para o post
Compartilhar em outros sites

Teste essa macro.

 

Considerei a coluna 3 onde os textos devem ser concatenados.

 

Sub Main()
    Dim C           As Range
    Dim rCelula     As Range
    Dim strTexto    As String
    
    For Each C In Range("C1:C" & Range("C60000").End(xlUp).Row)
        If C.Offset(, -1) <> "" And C.Offset(1, -2) = "" Then
            Set rCelula = C
            strTexto = C
        Else
            strTexto = strTexto & C
            If C.Offset(, 2) = "" Then
                rCelula.Value = strTexto
                Range("C" & rCelula.Row + 1 & ":C" & C.Row).Clear
            End If
        End If
    Next C
End Sub

 

Compartilhar este post


Link para o post
Compartilhar em outros sites
2 horas atrás, olliver.soul disse:

Teste essa macro.

 

Considerei a coluna 3 onde os textos devem ser concatenados.

 


Sub Main()
    Dim C           As Range
    Dim rCelula     As Range
    Dim strTexto    As String
    
    For Each C In Range("C1:C" & Range("C60000").End(xlUp).Row)
        If C.Offset(, -1) <> "" And C.Offset(1, -2) = "" Then
            Set rCelula = C
            strTexto = C
        Else
            strTexto = strTexto & C
            If C.Offset(, 2) = "" Then
                rCelula.Value = strTexto
                Range("C" & rCelula.Row + 1 & ":C" & C.Row).Clear
            End If
        End If
    Next C
End Sub

 

Funcionou para boa parte dos casos, mas por algum motivo ele pulou alguns e não concatenou. Mas já ta ajudando bastante. 

Valeu mesmo mano.

Compartilhar este post


Link para o post
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisar ser um membro 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 publicações 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

×