Ir para o conteúdo
tiago.nunes9

Agrupar e eliminar repetidos

Mensagens Recomendadas

tiago.nunes9    0
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á

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites
manuel antonio    3
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?

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites
manuel antonio    3
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.

 

Editado por manuel antonio

Partilhar esta mensagem


Link para a mensagem
Partilhar noutros sites

Crie uma conta ou ligue-se para comentar

Só membros podem comentar

Criar nova conta

Registe para ter uma conta na nossa comunidade. É fácil!

Registar nova conta

Entra

Já tem conta? Inicie sessão aqui.

Entrar Agora


×

Aviso Sobre Cookies

Ao usar este site você aceita os nossos Termos de Uso e Política de Privacidade