Tópicos relacionados a códigos VBA, gravação de macros, etc.
Por rafael84 03 Dez 2019 às 19:56
Membro Novato
Mensagens: 8
Reputação: 0
#50840
Pessoal preciso usar macro pra mesclar celulas..... preciso que isso:
n n2 n3
8 2 RAFAEL
9 2 RAFAEL
9 2 RAFAEL
9 2 RAFAEL
9 2 RAFAEL
10 2 RAFAEL
10 2 RAFAEL
10 2 RAFAEL
10 2 RAFAEL
11 2 RAFAEL
11 2 RAFAEL

12 2 RAFAEL
12 2 RAFAEL
12 2 RAFAEL
12 2 RAFAEL
12 2 RAFAEL
13 2 RAFAEL

fique assim:

n n2 n3
8 2 RAFAEL
9 2 RAFAEL
10 2 RAFAEL
11 2 RAFAEL

12 2 RAFAEL
13 2 RAFAEL

Como posso fazer para mesclar?? Pensei em fazer um if pelo n, mas colo mesclar com a proxima linha?
Por osvaldomp 04 Dez 2019 às 10:24
Membro 5 Estrelas
Mensagens: 1432
Reputação: 709
#50860
Me parece que não se trata de mesclar células e sim de excluir células com valores duplicados.

Sugestão: disponibilize aqui no fórum o seu arquivo Excel contendo uma planilha com alguns dados originais e ao lado coloque o resultado desejado.
Por rafael84 04 Dez 2019 às 13:22
Membro Novato
Mensagens: 8
Reputação: 0
#50870
Olá, basicamente preciso fazer algo como no exemplo, mas não estou conseguindo resolver como mesclar, não posso excluir porque há a coluna obs que não pode ser excluída.
Apenas usuários registrados podem ver ou baixar anexos.
Por osvaldomp 04 Dez 2019 às 17:03
Membro 5 Estrelas
Mensagens: 1432
Reputação: 709
#50895
Experimente:

Código: Selecionar todosSub RearranjaDados()
 Dim a As Range, x As Long, v As Long, n As Long
  Application.ScreenUpdating = False
  Columns("I:L").Clear
  For Each a In Columns(1).SpecialCells(2).Areas
   If a.Cells(1) Like "*sequencial*" Then
    Cells(a.Row, 9).Resize(, 4).Value = a.Cells(1).Resize(, 4).Value
    x = a.Cells(1).End(4).Row
    Cells(a.Row + 1, 12).Resize(x - a.Row).Value = a.Cells(2, 4).Resize(x - a.Row).Value
    For n = a.Row + 1 To x
     Cells(n, 9).Resize(, 3).Value = Cells(n, 1).Resize(, 3).Value
     v = Application.CountIf(Cells(n, 1).Resize(x - a.Row), Cells(n, 1))
     Cells(n, 9).Resize(v).Merge: Cells(n, 10).Resize(v).Merge: Cells(n, 11).Resize(v).Merge
     n = n + v - 1
    Next n
   Else: Cells(a.Row, 9) = a.Cells(1)
   End If
  Next a
  Columns("I:L").HorizontalAlignment = xlCenter
  Columns("I:L").VerticalAlignment = xlCenter
  Application.ScreenUpdating = True
End Sub