Tomás Vásquez Fórum

Enviado: **Dom Jun 16, 2019 10:21 pm**

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.

Enviado: **Sex Jun 21, 2019 1:49 pm**

Alguém?

Enviado: **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.

Enviado: **Sex Mar 12, 2021 12:20 pm**

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?

Enviado: **Qua Abr 20, 2022 6:53 pm**

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]

Tomás Vásquez Fórum

DUPLICIDADE - Mesmo Nome = Unir Serviços

DUPLICIDADE - Mesmo Nome = Unir Serviços

Re: DUPLICIDADE - Mesmo Nome = Unir Serviços

Re: DUPLICIDADE - Mesmo Nome = Unir Serviços

Re: DUPLICIDADE - Mesmo Nome = Unir Serviços

Re: DUPLICIDADE - Mesmo Nome = Unir Serviços