Notifications
Clear all

Mesclagem de colunas

7 Posts
3 Usuários
0 Reactions
1,817 Visualizações
 Ney
(@ney)
Posts: 13
Active Member
Topic starter
 

Pessoal Boa Tarde!!!

Tenho um pequeno problema, tenho uma coluna que me apresenta vários código, e nestes códigos me apresentam números repetidos, oque eu quero é mesclar quando este números forem repetidos, exemplo,


Código
1
2
3
4
4
5
6
6
6
7
8
9
10
11
11
12
13

Esta numeração chega passar de 1000, então para mesclar manualmente demora muito, a ideia e fazer a mesclagem através de algum tipo de comando.

Desde de já muito grato.

Att: Sidney

 
Postado : 29/06/2016 1:04 pm
(@vbajr10)
Posts: 34
Eminent Member
 

Amigo, você quer mesclar ou eliminar duplicatas?
Se for a segunda opção não necessita macro. Em dados eliminar duplicatas vc consegue o que quer..

 
Postado : 30/06/2016 5:54 pm
 Ney
(@ney)
Posts: 13
Active Member
Topic starter
 

Amigo bom dia!!

Neste caso realmente é mesclar os números iguais,

Grato, no aguardo!

Att: Sidney

 
Postado : 01/07/2016 5:21 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Utilize as rotinas abaixo :

Fonte:
Codigo para mesclar celulas iguais
http://comunidade.itlab.com.br/eve/foru ... /615602647

Option Explicit

Sub PreparaListaMesclada() 'By Badmoon
    'Percorre a coluna atual verificando se o conteudo das celulas é igual, se
    'for ira mescla-las e alinhar no centro
    
    Dim lngLinha As Long
    Dim lngProxima As Long
    Dim strColuna As String
    Dim lngColuna As Long
    Dim strConteudo As String
    Dim lngLinhaMesclar As Long
    Dim lngCelulasEmBranco As Integer
    
    Application.DisplayAlerts = False       'Desliga a confirmação do mesclar celulas
     
   ' lngColuna = ActiveCell.Column
    lngColuna = 1
    
    Do Until lngLinha = 1048576 'Percorre linha a linha ate a ultima da planilha
        lngLinha = lngLinha + 1
        lngLinhaMesclar = 0
        
        'Pega Conteudo da celula atual
        strConteudo = Cells(lngLinha, lngColuna).Formula
        
        If strConteudo = vbNullString Then
            lngCelulasEmBranco = lngCelulasEmBranco + 1
        Else
            lngCelulasEmBranco = 0
        End If
        
        'Mais de cinco celulas em branco entende como fim da lista
        If lngCelulasEmBranco > 5 Then Exit Do
        
        If Not strConteudo = vbNullString Then
            For lngProxima = lngLinha + 1 To 1048576
                If Cells(lngProxima, lngColuna).Formula = strConteudo Then
                    lngLinhaMesclar = lngProxima
                Else
                    Exit For
                End If
            Next
        
            If lngLinhaMesclar > 0 Then MesclaIntervalo lngLinha, lngLinhaMesclar, lngColuna
            
             lngLinha = lngProxima - 1
        End If
    Loop
    
    Cells(1, lngColuna).Select
    Application.DisplayAlerts = True
    
    MsgBox "Lista Pronta", vbOKOnly + vbExclamation, "Mesclar Lista"
    
End Sub
    
Private Sub MesclaIntervalo(Inicio, Fim, Coluna)
        
    Range(Cells(Inicio, Coluna), Cells(Fim, Coluna)).Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter ' ou xlBottom ou xlTop
        .WrapText = False
        .Orientation = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
    Selection.Merge
End Sub

[]s

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 01/07/2016 7:18 am
 Ney
(@ney)
Posts: 13
Active Member
Topic starter
 

Amigo,

Desculpe a minha ignorância, mas não acertei fazer a aplicação do código, criei um botão e em propriedades fui atribuir macros, e lá no construtor de códigos colei este código, mas não funcionou, exibiu uma mensagem dizendo, "Não é possível executar a macro 'Pasta1.xlsm"Retângulo_Clique'. Talvez ela não esteja nesta pasta de trabalho ou todas as macros estejam desesabilitadas".

Só que a macro esta habilitada.

Desde ja, grato!

Att; Sidney

 
Postado : 01/07/2016 8:52 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Você deve ter colado a rotina inteira no evento do Botão e não associado.
Faça o seguinte, no editor do VBE clique com Botão Direito na janela propriedades e selecione Inserir Modulo, feito isto cole as rotina, depois volte para a aba que colocou o botão e clique com o botão direito do mouse e escolha Atribuir Macro e na janela que aparecer selecione "PreparaListaMesclada".

[]s

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 01/07/2016 8:59 am
 Ney
(@ney)
Posts: 13
Active Member
Topic starter
 

Perfeito amigo, Deu certo, Obrigado!!

att; Sidney

 
Postado : 08/08/2018 1:51 pm