Página 1 de 1
DUPLICIDADE - Mesmo Nome = Unir Serviços
Enviado: Dom Jun 16, 2019 10:21 pm
por diegozl
Olá, boa noite.
Tenho uma planilha onde é informado em cada linha o Nome do Proprietário na coluna A e o Serviço desejado na coluna B. Ocorre que, as vezes, o mesmo Proprietário quer dois serviços.
Nesse caso, fica:
Joaozinho (Cel. A1) - Serv1 (Cel. B1)
Joaozinho (Cel. A2) - Serv2 (Cel. B2)
Meu objetivo seria uma macro onde, ao detectar duplicidade no nome, juntar o Serv2 à linha do Serv1, ou seja, ficar, "Joaozinho (Cel. A1) - Serv1 e Serv2 (Cel. B1)". Posteriormente, toda a linha do Serv2 seria apagada. É possível?
Encontrei, nesse mesmo fórum, opções de mesclar células e tentei adaptar ao meu caso, mas não consegui.
Re: DUPLICIDADE - Mesmo Nome = Unir Serviços
Enviado: Sex Jun 21, 2019 1:49 pm
por diegozl
Alguém?
Re: DUPLICIDADE - Mesmo Nome = Unir Serviços
Enviado: Qui Ago 06, 2020 7:49 am
por DANIELDDK
Bom dia, tente o código abaixo:
Creio que o ajudará, é só copiar e colar, segui a formatação que passou: Coluna A (Nome), Coluna B (Serviço), o mesmo está separando por Pipe (|), se for o caso altere a simbologia a ser utilizada na linha: "Range("B" & MY_ROWS - 1).Value = Range("B" & MY_ROWS - 1).Value & " | " & Range("B" & MY_ROWS).Value"
Código: Selecionar todos
Sub CombinarCelulas()
Columns("a:a").Select
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("Planilha2").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Planilha2").Sort.SortFields.Add2 Key:=Range("a1") _
, SortOn:[*]=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Planilha2").Sort
.SetRange Range("A2:A100000")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
MY_LAST_ROW = Range("A" & Rows.Count).End(xlUp).Row
ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("A2:A" & MY_LAST_ROW), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.ActiveSheet.Sort
.SetRange Range("A2:B" & MY_LAST_ROW)
.Apply
End With
Application.ScreenUpdating = False
For MY_ROWS = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
If Range("A" & MY_ROWS).Value = Range("A" & MY_ROWS - 1).Value Then
Range("B" & MY_ROWS - 1).Value = Range("B" & MY_ROWS - 1).Value & " | " & Range("B" & MY_ROWS).Value
Rows(MY_ROWS).Delete
End If
Next MY_ROWS
Application.ScreenUpdating = True
Columns("a:C").Select
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("Planilha2").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Planilha2").Sort.SortFields.Add2 Key:=Range("a1") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Planilha2").Sort
.SetRange Range("A2:C100000")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Esperto ter ajudado.
Re: DUPLICIDADE - Mesmo Nome = Unir Serviços
Enviado: Sex Mar 12, 2021 12:20 pm
por diegozl
DANIELDDK escreveu: ↑Qui Ago 06, 2020 7:49 am
Bom dia, tente o código abaixo:
Creio que o ajudará, é só copiar e colar, segui a formatação que passou: Coluna A (Nome), Coluna B (Serviço), o mesmo está separando por Pipe (|), se for o caso altere a simbologia a ser utilizada na linha: "Range("B" & MY_ROWS - 1).Value = Range("B" & MY_ROWS - 1).Value & " | " & Range("B" & MY_ROWS).Value"
Código: Selecionar todos
Sub CombinarCelulas()
Columns("a:a").Select
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("Planilha2").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Planilha2").Sort.SortFields.Add2 Key:=Range("a1") _
, SortOn:[*]=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Planilha2").Sort
.SetRange Range("A2:A100000")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
MY_LAST_ROW = Range("A" & Rows.Count).End(xlUp).Row
ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("A2:A" & MY_LAST_ROW), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.ActiveSheet.Sort
.SetRange Range("A2:B" & MY_LAST_ROW)
.Apply
End With
Application.ScreenUpdating = False
For MY_ROWS = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
If Range("A" & MY_ROWS).Value = Range("A" & MY_ROWS - 1).Value Then
Range("B" & MY_ROWS - 1).Value = Range("B" & MY_ROWS - 1).Value & " | " & Range("B" & MY_ROWS).Value
Rows(MY_ROWS).Delete
End If
Next MY_ROWS
Application.ScreenUpdating = True
Columns("a:C").Select
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("Planilha2").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Planilha2").Sort.SortFields.Add2 Key:=Range("a1") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Planilha2").Sort
.SetRange Range("A2:C100000")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Esperto ter ajudado.
Oi, Daniel. Boa tarde.
Primeiramente, desculpa tamanha demora. Não vi que havia tido resposta. Como entrei no fórum pra tirar outra dúvida, localizei sua mensagem.
Tentei aqui na planilha, mas dá o erro "
Erro de compilação: Erro de sintaxe" e o código
Código: Selecionar todos
ActiveWorkbook.Worksheets("Planilha2").Sort.SortFields.Add2 Key:=Range("a1") _
, SortOn:[*]=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal2
fica em vermelho, dando a entender estar incorreto. Você sabe dizer o que poderia ser?
Re: DUPLICIDADE - Mesmo Nome = Unir Serviços
Enviado: Qua Abr 20, 2022 6:53 pm
por DANIELDDK
diegozl, boa noite! Me desculpa eu, vir aqui dar a resposta agora. rsrsrs. Ano passado foi complicado.
Lembrando que a primeira linha é o cabeçalho.
Vi que o código não era para conter aquela linha de comando.
Segue modelo da planilha.
Código: Selecionar todos
Sub CombinarCelulas()
Columns("a:a").Select
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("Planilha2").Sort.SortFields.Clear
With ActiveWorkbook.Worksheets("Planilha2").Sort
.SetRange Range("A2:A100000")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
MY_LAST_ROW = Range("A" & Rows.Count).End(xlUp).Row
ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range("A2:A" & MY_LAST_ROW), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.ActiveSheet.Sort
.SetRange Range("A2:B" & MY_LAST_ROW)
.Apply
End With
Application.ScreenUpdating = False
For MY_ROWS = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
If Range("A" & MY_ROWS).Value = Range("A" & MY_ROWS - 1).Value Then
Range("B" & MY_ROWS - 1).Value = Range("B" & MY_ROWS - 1).Value & " | " & Range("B" & MY_ROWS).Value
Rows(MY_ROWS).Delete
End If
Next MY_ROWS
Application.ScreenUpdating = True
Columns("a:C").Select
Application.CutCopyMode = False
ActiveWorkbook.Worksheets("Planilha2").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Planilha2").Sort.SortFields.Add2 Key:=Range("a1") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Planilha2").Sort
.SetRange Range("A2:C100000")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
[code]