VARIAVEL-REMOVER DUPLICADOS
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.
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.
Esses valores serão sempre numéricos?
Sim, serão sempre numéricos.
Bom, temos dois approaches para sua solução, uma usando um recordset dinâmico e outra trabalhando puramente com uma array, qual você prefere?
Bom, se puder os dois exemplos....... Blz! Caso não, com array.
[ô]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
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
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
Deu erro aqui! Montei um exemplo com seu código. Veja o erro.
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
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
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!
vc não sabe passar um array para uma string ou uma label ?
no meu exemplo foi isto:
a ultima linha é para tirar a virgula no final da string...
adapte aà se quiser usar o exemplo do KERPLUNK
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
Tópico encerrado , respostas não são mais permitidas