Página 1 de 1
ELIMINAR REPETIDOS
Enviado: 05 Ago 2018 às 18:46
por xmiguelx
Boa noite!
Estou tentando adaptar o código VB para que não repita o número de nota para o mesmo produto.
Exemplo: O código de produto W0259171 está repetindo várias vezes á nota 000303651 e assim para outras notas sendo que gostaria que apareça somente uma vez essa nota para esse produto, e essa nota poderá aparecer em outros produtos.
Segue arquivo de exemplo o qual reproduzi manualmente na Sheet RESUMO, coluna U o objetivo que estou buscando que ocorra na Sheet RESUMO, coluna T quando é pressionado o botão RESUMO.
Abs
Re: ELIMINAR REPETIDOS
Enviado: 06 Ago 2018 às 08:55
por FelipeMGarcia
Amigo,
Veja se o que fiz lhe ajuda, caso queira agradecer, clique na mãozinha.
Abs
ELIMINAR REPETIDOS
Enviado: 06 Ago 2018 às 11:47
por xmiguelx
Bom dia amigo!
Estou tentando fazer via VB, pois meu relatório de notas pode passar de 2000 notas a cada reanalise.
Abs
ELIMINAR REPETIDOS
Enviado: 06 Ago 2018 às 14:37
por FelipeMGarcia
Se mudar de ideia, segue a fórmula:
=UNIRTEXTO(" , ";VERDADEIRO;MENOR(SE(FREQÜÊNCIA(SE(NOTAS!$B$3:$B$74=$B3;CORRESP(NOTAS!$D$3:$D$74;NOTAS!$D$3:$D$74;0));LIN(NOTAS!$D$3:$D$74)-LIN(NOTAS!$D$3)+1);NOTAS!$D$3:$D$74);LIN(INDIRETO("1:"&SOMA(SE(FREQÜÊNCIA(SE(NOTAS!$B$3:$B$74=$B3;CORRESP(NOTAS!$D$3:$D$74;NOTAS!$D$3:$D$74;0));LIN(NOTAS!$D$3:$D$74)-LIN(NOTAS!$D$3)+1);1))))))
Re: ELIMINAR REPETIDOS
Enviado: 06 Ago 2018 às 15:18
por osvaldomp
xmiguelx escreveu:Estou tentando fazer via VB, ...
Pode ser via VBA ?
Código: Selecionar todosSub Resumo()
Dim m As String, k As Long, x As Long
Application.ScreenUpdating = False
Sheets.Add
Sheets("NOTAS").Range("B3:D" & Sheets("NOTAS").Cells(Rows.Count, 2).End(3).Row).Copy [A3]
ActiveSheet.Range("A3:C" & Cells(Rows.Count, 1).End(3).Row).RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlNo
With Sheets("RESUMO")
.Columns(2) = "": .Columns(20) = "": .[B2] = "PRODUTO": .[T2] = "NOTAS"
For k = 3 To Cells(Rows.Count, 1).End(3).Row
x = Application.CountIf([A:A], Cells(k, 1))
If x = 1 Then
m = Cells(k, 3).Text
Else: m = Join(Application.Transpose(Cells(k, 3).Resize(x)), "; ")
End If
.Cells(Rows.Count, 2).End(3)(2) = Cells(k, 1)
.Cells(Rows.Count, 20).End(3)(2).NumberFormat = "@": .Cells(Rows.Count, 20).End(3)(2) = m
k = k + x - 1
Next k
End With
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
ELIMINAR REPETIDOS
Enviado: 06 Ago 2018 às 17:28
por xmiguelx
@ Felipe, muito obrigado pela sua ajuda, funcionou perfeitamente através de fórmula.
@Osvaldo, muito obrigado, realmente queria por VB devido a grande quantidade e assim minimizando o risco de deixar de colocar a fórmula em algum item.
Abs