Ir ao conteúdo
  • Cadastre-se

Dados repetidos em colunas em uma mesma linha


Visitante

Posts recomendados

Bom dia amigos,

Gostaria de saber se existe solução para o impasse que tenho.

Estou com uma lista com 35mil linhas, onde na coluna A tenho o nome da pessoa, na coluna D o DDD e na coluna E o telefone do mesmo.

Acontece que algumas pessoas possuem 2 ou 3 telefones cadastrados e eu precisava colocar em uma mesma linha segundo a seguinte ideia:

Caso a pessoa só tenha 1 telefone cadastrado na planilha, nada ocorre. Caso tenha 2 telefones, este segundo DDD seria incluído na coluna F e o segundo telefone na coluna G. Caso tenha um 3º telefone, este terceiro DDD seria incluído na coluna H e o terceiro telefone na coluna I.

É possível?

Se sim, como procedo?

Anexa uma imagem com um pequeno exemplo de como vejo a lista e como deveria ficar.

post-1023856-13884964645425_thumb.jpg

Link para o comentário
Compartilhar em outros sites

a) considerei os nomes ordenados, ou de A para Z ou de Z para A

B) o resultado será colocado pelo código a partir de 'G1'

Instale o código abaixo em um módulo comum, assim:

1. copie o código daqui

2. a partir da planilha em que estão os dados tecle 'Alt+F11' para acessar o editor de VBA

3. no menu do editor >> Inserir >> Módulo

4. cole o código na janela em branco que vai se abrir

5. feito! 'Alt+Q' para retornar para a planilha e testar

para rodar o código:

6. tecle 'Alt+F8' >> selecione a macro 'TranspNumTelef' >> Executar, ou insira um botão na planilha e vincule-o à macro

Sub TranspNumTelef()
Dim LR As Long, k As Long, x As Long, y As Long
Dim s As String, v As Variant, m As Long, i As Long
LR = Cells(Rows.Count, 1).End(xlUp).Row
For k = 1 To LR
x = Application.CountIf(Range(Cells(k + 1, 1), _
Cells(LR, 1)), Cells(k, 1).Value)
If x > 0 Then
For y = 1 To x
s = s & "," & Cells(k + y, 4) & "," & Cells(k + y, 5).Value
Next y
v = Split(s, ",")
Cells(1 + m, 7).Value = Cells(k, 1).Value
Cells(1 + m, 8).Resize(, 2).Value = Cells(k, 4).Resize(, 2).Value

For i = LBound(v) + 1 To UBound(v)
Cells(1 + m, i + 9) = v(i)
Next i
k = k + x
s = ""
Else:
Cells(1 + m, 7).Value = Cells(k, 1).Value
Cells(1 + m, 8).Resize(, 2).Value = Cells(k, 4).Resize(, 2).Value
End If
m = m + 1
Next k
End Sub

Link para o comentário
Compartilhar em outros sites

a) considerei os nomes ordenados, ou de A para Z ou de Z para A

B) o resultado será colocado pelo código a partir de 'G1'

Instale o código abaixo em um módulo comum, assim:

1. copie o código daqui

2. a partir da planilha em que estão os dados tecle 'Alt+F11' para acessar o editor de VBA

3. no menu do editor >> Inserir >> Módulo

4. cole o código na janela em branco que vai se abrir

5. feito! 'Alt+Q' para retornar para a planilha e testar

para rodar o código:

6. tecle 'Alt+F8' >> selecione a macro 'TranspNumTelef' >> Executar, ou insira um botão na planilha e vincule-o à macro

Sub TranspNumTelef()
Dim LR As Long, k As Long, x As Long, y As Long
Dim s As String, v As Variant, m As Long, i As Long
LR = Cells(Rows.Count, 1).End(xlUp).Row
For k = 1 To LR
x = Application.CountIf(Range(Cells(k + 1, 1), _
Cells(LR, 1)), Cells(k, 1).Value)
If x > 0 Then
For y = 1 To x
s = s & "," & Cells(k + y, 4) & "," & Cells(k + y, 5).Value
Next y
v = Split(s, ",")
Cells(1 + m, 7).Value = Cells(k, 1).Value
Cells(1 + m, 8).Resize(, 2).Value = Cells(k, 4).Resize(, 2).Value

For i = LBound(v) + 1 To UBound(v)
Cells(1 + m, i + 9) = v(i)
Next i
k = k + x
s = ""
Else:
Cells(1 + m, 7).Value = Cells(k, 1).Value
Cells(1 + m, 8).Resize(, 2).Value = Cells(k, 4).Resize(, 2).Value
End If
m = m + 1
Next k
End Sub

Osvaldo...

Funcionou perfeitamente a vossa macro.

Muito obrigado pela ajuda!

Link para o comentário
Compartilhar em outros sites

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

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...

 

GRÁTIS: ebook Redes Wi-Fi – 2ª Edição

EBOOK GRÁTIS!

CLIQUE AQUI E BAIXE AGORA MESMO!