Supprimer un doublons mais dans un tableau array() et pas access ni excel !

Version imprimable

Bonjour à tous,

J'ai deux tableaux en vba (un array directement, je ne parle pas d'une table access ou excel) type1() et nom1 () qui contiennent les noms des fichiers qui se trouve dans un dossier. Je récupère tout ça en vba.

En fait un fichier se nomme "type01_formulaire01.dot" par exemple, le tableau type1 récupère "type01" et nom1 récupère "formulaire01.dot".

Mon souci est que je les envoi dans des combobox pour que l'utilisateur puisse choisir un type ou un nom de formulaire, seulement par exemple il peut y avoir plusieurs fois le type01.

Comment puis-je supprimer les doublons de mes tableau ?

Je m'en remet à vous, j'ai cherché partout sur le net mais les gens veulent seulement supprimer les doublons d'une table excel ou access !

Merci énormément d'avance :calim2:

ps: mon code si ça peut aider :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 Private Sub Form_Load() Dim Fso As Scripting.FileSystemObject Dim SourceFolder As Scripting.Folder Dim FileItem As Scripting.File Dim i As Long Dim repertoire Dim nom1() Dim type1() Dim fich Dim typ repertoire = "C:\Documents and Settings\993921\Bureau\LOLA1\modele word" Set Fso = CreateObject("Scripting.FileSystemObject") Set SourceFolder = Fso.GetFolder(repertoire) i = 0 'Boucle sur tous les fichiers du répertoire For Each FileItem In SourceFolder.Files typ = Left(FileItem.Name, 6) fich = Right(FileItem.Name, (Len(FileItem.Name) - 7)) ReDim Preserve nom1(i) ReDim Preserve type1(i) nom1(i) = fich type1(i) = typ Me.cbo_type.AddItem type1(i) Me.cbo_nom.AddItem nom1(i) Next FileItem End Sub

Bjr
Sans doute te suffrait il de tester, avant de renseigner tes tableaux "nom1()" et "type1()" que la valeur que tu souhaites y mettre n'y est pas déjà...

Par exemple :
Avant d'augmenter la taille de chacun de tes deux tableaux et d'y affecter une valeur tu fais une boucle te permettant de tester que la valeur n'existe pas déjà dans le style :
Code:

1 2 3 4 5 6 7 8 NomExistant = False TypeExistant= False For J = 0 To UBound(nom1) If nom1(J) = fich Then NomExistant = True Next J For J = 0 To UBound(type1) If type1(J) = typ Then TypeExistant = True Next J
et bien sûr tu n'augmentes la taille et ne renseignes tes deux tableaux que lorsque NomExistant = False et TypeExistant = False au sortir des deux boucles FOR J / Next J (peut être faut-il donner comme butoir Ubond(TesTableaux) - 1 et non comme je l'écris plus haut ubond(TesTableaux)... à vérifier.

Au passage, dans ton code, je vois que la valeur de "i" n'est jamais incrémentée... est-ce normal ?

Michel

09/02/2012, 11h20
Adweuz

Merci énormément de ta réponse !

Non en effet ce n'est pas normal j'ai du l'enlever sans faire exprès en recopiant mon code sur le forum en supprimant un commentaire mais il est bel est bien dans mon code !

Je vais tester ta méthode et je reviens !

NICKEL ça marche ! J'ai du faire encore plein de test et de changement (notamment au niveau de l'endroit ou placer mes incrémentations) mais ça y est ça marche !!!!

Un énorme merci à toi !!!

Je met mon code final si ça intéresse de futur coincé !

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Private Sub Form_Load()
 
    Dim Fso As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.Folder
    Dim FileItem As Scripting.File
    Dim i, j, k As Long
    Dim repertoire
    Dim nom1()
    Dim type1()
    Dim fich, typ As String
    Dim NomExistant, TypeExistant As Boolean
 
    repertoire = "C:\Documents and Settings\999999\Bureau\LOLA1\modele word"
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = Fso.GetFolder(repertoire)
 
    i = 1
    k = 1
    ReDim Preserve nom1(0)
    ReDim Preserve type1(0)
 
    nom1(0) = ""
    type1(0) = ""
 
    'Boucle sur tous les fichiers du répertoire
    For Each FileItem In SourceFolder.Files
 
        typ = Left(FileItem.Name, 6)
        fich = Right(FileItem.Name, (Len(FileItem.Name) - 7))
 
        NomExistant = False
        TypeExistant = False
 
        For j = 0 To UBound(nom1)
            If nom1(j) = fich Then NomExistant = True
        Next j
 
        If NomExistant = False Then
            ReDim Preserve nom1(i)
            nom1(i) = fich
            Me.cbo_nom.AddItem nom1(i)
            i = i + 1
        End If
 
        For j = 0 To UBound(type1)
            If type1(j) = typ Then TypeExistant = True
        Next j
 
        If TypeExistant = False Then
            ReDim Preserve type1(k)
            type1(k) = typ
            Me.cbo_type.AddItem type1(k)
            k = k + 1
        End If
 
    Next FileItem
 
End Sub