VARIAVEL-REMOVER DUPLICADOS

IRENKO 14/05/2013 10:53:32
#423440
Dim Dados AS String

Dados = [Ô]0031,0031,0031,0046,0046,[Ô]

A pergunta é: é possivel via codigo verificar se exite duplicados, e se sim, remove-los?

Deixando:

Dados = [Ô]0031,0046[Ô]

Grato.
KERPLUNK 14/05/2013 10:59:54
#423441
Resposta escolhida
Esses valores serão sempre numéricos?
IRENKO 14/05/2013 11:13:12
#423442
Sim, serão sempre numéricos.
KERPLUNK 14/05/2013 12:11:59
#423446
Bom, temos dois approaches para sua solução, uma usando um recordset dinâmico e outra trabalhando puramente com uma array, qual você prefere?
IRENKO 14/05/2013 12:24:26
#423449
Bom, se puder os dois exemplos....... Blz! Caso não, com array.
KERPLUNK 14/05/2013 14:11:47
#423453

[ô]para usar
Dados = [Ô]0031,0031,0031,0046,0046,0089,0089,0089,0015[Ô]
Dim tudo
tudo = RipDuplicates(Dados)

[ô]em algum módulo
Public Function RipDuplicates(aArray As Variant)
Dim retorno() As String
tmpaArray = Split(aArray, [Ô],[Ô])
For i% = LBound(tmpaArray) To UBound(tmpaArray)
If i% = 0 Then
ReDim Preserve retorno(0)
retorno(i%) = tmpaArray(i%)
Else
If Not ValueInAray(retorno, tmpaArray(i%)) Then
ReDim Preserve retorno(UBound(retorno) + 1)
retorno(UBound(retorno)) = tmpaArray(i%)
End If
End If
Next i%
RipDuplicates = retorno
End Function

Public Function ValueInAray(aArray As Variant, Valor As Variant) As Boolean
If UBound(aArray) = 0 Then
If aArray(0) = Valor Then
ValueInAray = True
Exit Function
Else
ValueInAray = False
Exit Function
End If
End If


For i% = LBound(aArray) To UBound(aArray)
If aArray(i%) = Valor Then
ValueInAray = True
Exit Function
End If
Next i%
ValueInAray = False
End Function

GANDA.NICK 14/05/2013 14:29:26
#423456
Mais um exemplo que tinha feito à um tempo:

Option Explicit

Private Function RemoverRepetidos(ByRef sStr As String)
Dim arrSplit() As String
Dim i As Long, i2 As Long, i3 As Long

If Right$(sStr, 1) = [Ô],[Ô] Then sStr = Left$(sStr, Len(sStr) - 1)
arrSplit = Split(sStr, [Ô],[Ô])

For i = LBound(arrSplit) To UBound(arrSplit) - 1
For i2 = i + 1 To UBound(arrSplit)
If arrSplit(i) = arrSplit(i2) Then
For i3 = i2 To UBound(arrSplit) - 1
arrSplit(i3) = arrSplit(i3 + 1)
Next [ô]i3
ReDim Preserve arrSplit(UBound(arrSplit) - 1) As String
i2 = i2 - 1
End If
If i2 = UBound(arrSplit) Then Exit For
Next [ô]i2
Next [ô]i

sStr = Empty
For i = LBound(arrSplit) To UBound(arrSplit)
sStr = sStr & arrSplit(i) & [Ô],[Ô]
Next [ô]i

If Right$(sStr, 1) = [Ô],[Ô] Then sStr = Left$(sStr, Len(sStr) - 1)
RemoverRepetidos = sStr
End Function

Private Sub Command1_Click()
Dim Dados As String
Dados = [Ô]0031,0031,0031,0046,0046,[Ô]
MsgBox RemoverRepetidos(Dados)
End Sub
IRENKO 14/05/2013 14:30:03
#423457
Deu erro aqui! Montei um exemplo com seu código. Veja o erro.
GANDA.NICK 14/05/2013 14:43:06
#423458
nesse exemplo do KERPLUNK o erro é que a variavel [Ô]tudo[Ô] é um ARRAY

mude essa linha do erro pelo code abaixo pra ver o retorno do ARRAY

    Dim i As Integer

For i = LBound(tudo) To UBound(tudo)

MsgBox tudo(i)

Next [ô]i
IRENKO 14/05/2013 15:04:16
#423460
GANDA_NIK, testei seu exemplo e funcionou perfeitamente mesmo mostrando o resultado em um label. Ja o do KERPLUNK não funciona mosntrando em um label!
GANDA.NICK 14/05/2013 15:16:08
#423461
vc não sabe passar um array para uma string ou uma label ?

no meu exemplo foi isto:


    sStr = Empty
For i = LBound(arrSplit) To UBound(arrSplit)
sStr = sStr & arrSplit(i) & [Ô],[Ô]
Next [ô]i

If Right$(sStr, 1) = [Ô],[Ô] Then sStr = Left$(sStr, Len(sStr) - 1)



a ultima linha é para tirar a virgula no final da string...

adapte aí se quiser usar o exemplo do KERPLUNK
Página 1 de 2 [13 registro(s)]
Tópico encerrado , respostas não são mais permitidas