Filtre doublons d'une colonne et les range dans un tableau

[Anne]

Hello,
voici une petite contribution :

J'ai sans doute mal cherché mais je n'ai pas trouvé d'algo sur le forum répondant à mon besoin : filtrer les données d'un range (supprimer les doublons) et les ranger dans un tableau pour ensuite faire un traitement avec ces données (dans une boucle par exemple).

Sans doute existe-t'il plus efficace mais voici un algo qui fait ça et qui marche pour ceux que ça interesse :

Dans mon Range E12 à la fin, j'ai plein de données en doublon : je les filtre et je les range dans le tableau Tab1.

Sub Filtre_Doublons()
Dim Tab1() as String
Dim i As Integer, y As Integer, x As Integer, k As Integer
Dim plage As Range
Dim cell As Range
Dim Item As String

Set plage = Sheets("maFeuille").Range("E12", [e65536].End(xlUp))

ReDim Tab1(1 To plage.Count + 1)
i = 0
Item = ""
y = 1
For Each cell In plage
i = i + 1
Tab1(i) = cell.Text
Next

For x = 2 To i
Item = Tab1(x)
Tab1(y + 1) = Item
k = 1
While Tab1(k) <> Item
k = k + 1
Wend
If k = y + 1 Then
y = y + 1
End If

Next x

ReDim Preserve Tab1(1 To k)
End Sub

 

[@+Thierry]

Salut Anne et le Forum...

Merci pour cet exemple, c'est très bien de montrer cette possibilité de travailler directement en intégrant des tableaux entier en variable "dynamic array".

Voici ce que je fais pour construire une table de trois colonnes indéxées sequentiellement qui me génère deux listBox dans un UserForm et me permets de faire diverses Stats en temps rééls sur la mémoire, sans consulter la feuille... La ListBox1 étant la récupération de ma liste de fournisseurs dans une feuille qui se créé donc à l'initialisation du USF. (Avec Tri Alpha et suppression de Doublon)

Quand on click sur cette ListBox1, elle génère la Listbox2 qui présentera les diverses comptes imputés à ce fournisseur sélectionné.
Ceci se fait toujours avec les données stockées en dynamic array, avec de nouveau un Tri et suppression de doublon.

Lorsque l'on sélectionne un de ces Comptes, je récupère la somme globale de ce Fournisseur avec ce Compte dans une label. Je compte aussi le nombre de d'écritures... etc etc, Depuis l'initialisation, toutes les données nécessaires sont stockées dans ce tableau en trois colonnes, donc plus de lecture sur la feuille...

Voici les codes successifs. (A titre d'info/exemple simplement, car un simple copié/collé ne risquera pas de marcher)

Option Explicit
Public Tab1() As String
Public Tab2() As String
Public Tab3(1 To 100) As String
Public Tab4(1 To 100) As String

Private Sub UserForm_Initialize()
Dim i As Integer
Dim plage As Range
Dim Cell As Range
Dim Item As String

If Sheets(1).AutoFilterMode Then Sheets(1).AutoFilterMode = False
ListBoxSuppliers.ColumnCount = 1
Set plage = ThisWorkbook.Sheets("Database").Range("K3:" _
& ThisWorkbook.Sheets("Database").Range("K65536").End(xlUp).Address)
ReDim Tab1(1 To plage.Count, 1 To 3)
i = 0
For Each Cell In plage
i = i + 1
With Cell
Tab1(i, 1) = .Text
Tab1(i, 2) = .Offset(0, -5).Text
Tab1(i, 3) = .Offset(0, 8).Value
End With
Next
TriListBox1
DoublonSuppliers
End Sub

Sub TriListBox1()
Dim ValMin As Integer, ValSup As Integer
Dim i As Integer, j As Integer, ii As Integer, iii As Integer
Dim t1 As String, t2 As String, t3 As String
ValMin = LBound(Tab1)
ValSup = UBound(Tab1)
For i = ValMin To ValSup
For j = ValMin + ii To ValSup
If Tab1(i, 1) > Tab1(j, 1) Then
t1 = Tab1(j, 1): t2 = Tab1(j, 2): t3 = Tab1(j, 3)
Tab1(j, 1) = Tab1(i, 1): Tab1(j, 2) = Tab1(i, 2): Tab1(j, 3) = Tab1(i, 3)
Tab1(i, 1) = t1: Tab1(i, 2) = t2: Tab1(i, 3) = t3
End If
Next j
ii = ii + 1
Next i
End Sub
Sub DoublonSuppliers()
Dim i As Integer, ii As Integer, iii As Integer
Dim Item As String
Item = ""
Me.ListBoxSuppliers.Clear
For i = LBound(Tab1) To UBound(Tab1)
If Item = Tab1(i, 1) Then
ii = ii + 1
Else
Item = Tab1(i, 1)
Me.ListBoxSuppliers.AddItem Item
iii = iii + 1
Tab3(iii) = i
ii = 1
End If
Next i
Tab3(iii + 1) = i - 1
End Sub


Private Sub ListBoxSuppliers_Click()
Dim ValMin As Integer
Dim ValSup As Integer
Dim Item As String
Dim i As Integer

ValMin = Tab3(Me.ListBoxSuppliers.ListIndex + 1)
Item = Tab1(ValMin, 1)
Me.ListBoxAccounts.Clear
ValSup = Tab3(Me.ListBoxSuppliers.ListIndex + 2) - Tab3(Me.ListBoxSuppliers.ListIndex + 1)
ReDim Tab2(1 To ValSup, 1 To 2)
Do While Item = Tab1(ValMin, 1)
i = i + 1
Tab2(i, 1) = Tab1(ValMin, 2)
Tab2(i, 2) = Tab1(ValMin, 3)
ValMin = ValMin + 1
Loop
TriListBox2
DoublonAccounts
End Sub

Sub TriListBox2()
Dim ValMin As Integer, ValSup As Integer
Dim i As Integer, j As Integer, ii As Integer
Dim t1 As String, t2 As String
ValMin = LBound(Tab2)
ValSup = UBound(Tab2)
For i = ValMin To ValSup
For j = ValMin + ii To ValSup
If Tab2(i, 1) > Tab2(j, 1) Then
t1 = Tab2(j, 1): t2 = Tab2(j, 2)
Tab2(j, 1) = Tab2(i, 1): Tab2(j, 2) = Tab2(i, 2)
Tab2(i, 1) = t1: Tab2(i, 2) = t2
End If
Next j
ii = ii + 1
Next i
For i = 1 To ValSup
Debug.Print i, Tab2(i, 1)
Next

End Sub
Sub DoublonAccounts()
Dim i As Integer, ii As Integer, iii As Integer
Dim ValMin As Integer, ValSup As Integer
Dim Item As String
Item = ""
Me.ListBoxAccounts.Clear

ValMin = LBound(Tab2)
ValSup = UBound(Tab2)
For i = ValMin To ValSup
If Item = Tab2(i, 1) Then
ii = ii + 1
Else
Item = Tab2(i, 1)
Me.ListBoxAccounts.AddItem Item
iii = iii + 1
Tab4(iii) = i
ii = 1
End If

Next i
Tab4(iii + 1) = i - 1
End Sub

Private Sub ListBoxAccounts_Click()
Dim ValMin As Integer
Dim ValSup As Integer
Dim Item As String
Dim i As Integer
Dim S As Integer
Dim Somme As Currency

LabelCountAc1 = ListBoxAccounts
ValMin = LBound(Tab2)
ValSup = UBound(Tab2)

S = 0
For i = ValMin To ValSup
If LabelCountAc1 = Tab2(i, 1) Then
S = S + 1
Somme = Somme + Tab2(i, 2)
End If
Next i
LabelCountAc2 = "Number of Input : " & S
LabelBALANCE = "Balance USD : " & Format(Somme, "# ##0.00")
End Sub


Voilà en espérant que çà ne donnera pas mal à la tête à Moa, ou que çà va faire poser des questions par Fabrice !! lol

Bon Allez bonne fin de journée
@+Thierry

 

[Anne]

C'est super classe Thierry.
Un truc que je n'ai pas précisé dans mon précédent message, c'est que j'ai récupéré (dans la 1ere partie du code : celle qui remplie le tableau en 1er lieu de tous les éléments) un morceau de l'un de tes codes (dont je ne parviens pas à récupéré le fil car j'ai un problème pour accéder au forum, je suis obligée de passer par "200 derniers messages").

A++

Anne

 

[Anne]

OUPS !

Dans mon code, il faut lire
ReDim Preserve Tab1(1 To y)
et non pas
ReDim Preserve Tab1(1 To k)
puisque k peut-être réinitialisé à 1 avant de sortir de la boucle.

Toutes mes confuses...