Agrupar e eliminar repetidos

[tiago.nunes9]

Boas,
Antes demais não sei é através de VBA que se pode fazer isso.
Eu sei que dá para fazer um a um ou através de "agrupar" e formula somar, mas eu queria saber se era possivel através de vba fazer tudo.
No excel eu tenho um coluna A que é a referencia, coluna B o nome do artigo, coluna C a quantidade, e coluna D que é a dizer "UN".
O meu objectivo era apagar as linhas repetidas e somar a quantidade que têm.
Obrigado desde já

[manuel antonio]

Bom dia.

Quase tudo é possível com VBA.

Mas esse Português deixa um bocado a desejar.

Por certo, pretendes somar primeiro e apagar depois ou então depois de apagado não somas coisa nenhuma.

Depois, tens com certeza um critério de procura que pode ser pela referência ou pelo nome. Na exposição do problema não especificas nada e numa boa exposição começa a resolução.

Pretendes procurar pela referência?

[manuel antonio]

Boa noite.

Para procurar duplicados, adapta esta rotina:

Private Sub CommandButton2_Click()
Sheets("Folha1").Select
ListBox1.Clear

Dim X As Long, QT As Integer
Dim Dup As Variant
Dim EndRow As Long
EndRow = Range("A" & 20000).End(xlUp).Row
Range("J" & 25).Value = ""
For X = EndRow To 1 Step -1

If Range("A" & X) <> "" Then

If Application.WorksheetFunction.CountIf(Range("A1:A" & X), Range("A" & X).Text) > 1 Then
Range("A" & X).Interior.Color = 8454143 'RGB(200, 160, 35)

  With Me.ListBox1
    .ColumnCount = 2
    For Each Dup In Range("A" & X)

      .AddItem
        ListBox1.ColumnWidths = "70;100"
      .List(.ListCount - 1, 0) = Range("A" & X) '.ForeColor = 16711680
      .List(.ListCount - 1, 1) = Range("B" & X) '.ForeColor= 255

QT = Range("C" & X).Value

Range("J" & 25).Value = Range("J" & 25).Value + QT
    Next Dup
  End With

End If
End If

Next X
MsgBox "--  VERIFICAÇÃO CONCLUÍDA.  --"
End Sub

Para os eliminar, adapta esta:

Private Sub CommandButton3_Click()

Dim X As Long
Dim EndRow As Long
EndRow = Range("A" & 20000).End(xlUp).Row
For X = EndRow To 1 Step -1

If Range("A" & X).Interior.Color = 8454143 Then
Range("A" & X).EntireRow.Delete

    End If

Next X

ListBox1.Clear

MsgBox "--  PROCURE NOVAMENTE DUPLICADOS  --"
End Sub

A primeira rotina utiliza o apoio de uma Listbox para apresentar os resultados.

Agora tu, adapta de acordo com as tuas necessidades.

Edited February 18, 2017 at 10:15 AM by manuel antonio