Vídeo recomendado
https://youtu.be/diWPPPhW-9E
https://youtu.be/diWPPPhW-9E
DUPLICIDADE - Mesmo Nome = Unir Serviços
DUPLICIDADE - Mesmo Nome = Unir Serviços
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.
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
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"
Esperto ter ajudado.
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
Re: DUPLICIDADE - Mesmo Nome = Unir Serviços
Oi, Daniel. Boa tarde.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"
Esperto ter ajudado.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
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
Re: DUPLICIDADE - Mesmo Nome = Unir Serviços
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.
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]
- Anexos
-
- Teste_Juntar.zip
- (13.47 KiB) Baixado 89 vezes