Página 1 de 1

Alinhar Células Duplicadas em Colunas Diferentes

Enviado: 11 Jul 2021 às 00:24
por Gabdivino
Boa noite pessoal. Trabalho em supermercado e tenho um modelo de negociação que gostaria da ajuda de vocês para poder acelerar um pouco o meu processo, pois acaba que perco muito tempo passando todos os pedidos de cada loja na planilha.

Gostaria de poder fazer com que todos os itens na Coluna B estivessem alinhados à Coluna A, porém preciso que o valor que se encontra na Coluna C se alinhe junto à Coluna B. Se puderem me ajudar agradeço muito, obrigado. Qualquer pergunta por favor só falar. Acabo sendo meio leigo, e só consigo usar os comandos que vem no Kutools, mas não parece que ele tenha uma opção que possa me ajudar, não que seja do meu conhecimento.

Vou deixar em anexo a planilha em questão;

Re: Alinhar Células Duplicadas em Colunas Diferentes

Enviado: 11 Jul 2021 às 10:04
por osvaldomp
Olá, @Gabdivino .

Veja se aproveita algum dos dois códigos abaixo.

A diferença entre eles é que o primeiro irá colocar o resultado na própria Plan2, para isso as listas das colunas A e B devem estar ordenadas antes de rodar o código, conforme o exemplo que você postou e todos os nomes de produtos da coluna B devem estar também na coluna A, conforme o exemplo que você postou,

já o segundo irá colocar o resultado na Plan3 e as listas de A e de B não precisam estar ordenadas e a lista de B pode ser diferente de A.
#
Código: Selecionar todos
Sub AlinhaProdutosPlan2()
 Dim p As Range
  Application.ScreenUpdating = False
  With Sheets("Plan2")
   For Each p In .Range("A1:A" & .Cells(Rows.Count, 1).End(3).Row)
    If p.Value <> p.Offset(, 1).Value Then p.Offset(, 1).Resize(, 2).Insert xlDown
   Next p
  End With
End Sub
#
Código: Selecionar todos
Sub AlinhaProdutosPlan3()
 Dim po As Range, pd As Range
  Application.ScreenUpdating = False
  Sheets("Plan3").[A:C] = ""
  With Sheets("Plan2")
  .Range("A1:A" & .Cells(Rows.Count, 1).End(3).Row).Copy Sheets("Plan3").[A1]
   For Each po In .Range("B1:B" & .Cells(Rows.Count, 2).End(3).Row)
    Set pd = Sheets("Plan3").[A:A].Find(po.Value)
    If Not pd Is Nothing Then
     po.Resize(, 2).Copy pd.Offset(, 1)
    Else: MsgBox "PRODUTO NÃO ENCONTRADO": po.Interior.Color = vbYellow
    End If
   Next po
  End With
  Sheets("Plan3").Columns("A:C").AutoFit
End Sub