[XL2010] Probleme création dictionnaire

**rsane** · 21/10/2015, 11h36

Bonjour je souhaite créer un dictionnaire qui prend en compte les éléments d'une colonne mais il me prend en compte les doublons, savez-vous où peut se trouver le souci ? voici le code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Sub LancementPilotage()
Dim dicofic As Dictionary
Dim i As Integer, j As Integer, k As Integer, nb As Integer, ii As Integer
Dim l As Integer, pos As Integer
Dim y As Integer, m As Integer, d As Integer, h As Integer, n As Integer
Dim classeur_courant As String, dossier_save As String, elem
Dim fso As Object, Dossier As Object, Folder As Object, fles As Object
Dim listfic() As String, tab_temp() As String
 
classeur_courant = ThisWorkbook.Name
dossier_save = Workbooks(classeur_courant).Worksheets("Menu").Range("A10")
 
Set fso = CreateObject("Scripting.FileSystemObject")
Set Dossier = fso.GetFolder(dossier_save)
 
 
 
'''Création d'un dictionnaire pour le stockage des fichiers déja existants'''
Set dicofic = CreateObject("Scripting.Dictionary")
 
For j = 1 To ThisWorkbook.Sheets("Pilotage").Range("A65536").End(xlUp).Row - 1
    If Not dicofic.Exists(ThisWorkbook.Sheets("Pilotage").Range("A" & j + 1).Value) Then
        dicofic.Add ThisWorkbook.Sheets("Pilotage").Range("A" & j + 1), ""
    End If
Next j
 
...
...
...
End Sub

Merci,

Cdlmt

**antonysansh** · 21/10/2015, 11h45

Bonjour,

Perso j'utilise le On error resume next (pas propre mais efficace) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub LancementPilotage()
    Dim dicofic As Dictionary, rg As Range, t()
    Dim i As Integer, j As Integer, k As Integer, nb As Integer, ii As Integer
    Dim l As Integer, pos As Integer
    Dim y As Integer, m As Integer, d As Integer, h As Integer, n As Integer
    Dim classeur_courant As String, dossier_save As String, elem
    Dim fso As Object, Dossier As Object, Folder As Object, fles As Object
    Dim listfic() As String, tab_temp() As String
 
    classeur_courant = ThisWorkbook.Name
    dossier_save = Workbooks(classeur_courant).Worksheets("Menu").Range("A10")
 
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set Dossier = fso.GetFolder(dossier_save)
 
 
    '''Création d'un dictionnaire pour le stockage des fichiers déja existants'''
    Set dicofic = CreateObject("Scripting.Dictionary")
    With ThisWorkbook.Sheets("Pilotage")
        Set rg = .Range(.Cells(2, 1), .Cells(Application.Rows.Count, 1).End(xlUp))
        t = rg
    End With
    On Error Resume Next
        For j = 1 To UBound(t)
            dicofic.Add t(j, 1), t(j, 1)
        Next j
    On Error GoTo 0
End Sub

**rsane** · 21/10/2015, 11h54

J'ai implémenté ton code mais ça me fait exactement la meme chose ! Suis-je le seul à avoir un dictionnaire avec des doublons ? Alors que c'est censé ne pas etre possible :/

Au passage, je suis un débutant en dictionnaire, je souhaite utiliser cette méthode car mon code doit ouvrir successivement des centaines de fichiers... je souhaite donc économiser du temps sur la recherche des doublons

Invité · 21/10/2015, 12h04

Bonjour,
n’utilises jamais on error si tu n'as pas la compétence pour le gérer!

une erreur est préférable à un fonctionnement inattendu!

Dim dicofic As New Dictionary !

dicofic.Add ThisWorkbook.Sheets("Pilotage").Range("A" & j + 1)

**rsane** · 21/10/2015, 13h33

Merci rdurupt, j'ai bien pris en compte vos modification par contre quand je boucle sur mes dossier, il ne prend pas en compte les variables de mon dico, entre la ligne 9 et la ligne 13, pourtant à l'écriture ca fonctionne bien, il n'y a pas de doublons.. c'est juste quand je l'effectue en pas à pas que je remarque cette coquille:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
59
60
61
62
63
64
65
66
67
68
 
'''Boucle dans le dossier SAVE
For Each Flder In Dossier.SubFolders
    Erase listfic
    k = -1
'''Création d'un tableau comprenant les fichiers non présents dans l'onglet Pilotage'''
    For Each fles In Flder.Files
 
        If Not dicofic.Exists(fles.Name) Then
            k = k + 1
            ReDim Preserve listfic(k)
            listfic(k) = fles.Name
        End If
    Next fles
'''Tri du tableau des fichiers
    If k <> -1 Then
        nb = UBound(listfic)
        tab_temp = listfic
        Erase listfic
        ReDim listfic(nb)
 
        For i = 0 To nb
            pos = 0
            For l = 0 To nb
                If tab_temp(i) > tab_temp(l) And i <> l Then
                    pos = pos + 1
                End If
            Next l
            For ii = 1 To 1
                If listfic(pos) = "" Then
                    listfic(pos) = tab_temp(i)
                Else
                    pos = pos + 1
                    ii = ii - 1
                End If
            Next ii
        Next i
    End If
'''Boucle dans le tableau des fichiers d'un dossier
    maLigne = Range("A1048576").End(xlUp).Row
    For Each elem In listfic()
          '''Instructions....
     Next elem
 
Next Flder
 
'on efface le quadrillage existant
With Workbooks(classeur_courant).Sheets("Pilotage").Range("A1:CZ1000")
    .Borders(xlEdgeLeft).LineStyle = xlNone
    .Borders(xlEdgeTop).LineStyle = xlNone
    .Borders(xlEdgeBottom).LineStyle = xlNone
    .Borders(xlEdgeRight).LineStyle = xlNone
    .Borders(xlInsideVertical).LineStyle = xlNone
    .Borders(xlInsideHorizontal).LineStyle = xlNone
End With
    'on en remet un
last_row_pil = Workbooks(classeur_courant).Sheets("Pilotage").Range("A" & Rows.Count).End(xlUp).Row
last_col_pil = Workbooks(classeur_courant).Sheets("Pilotage").Cells(1, Cells.Columns.Count).End(xlToLeft).Column
With Range(Workbooks(classeur_courant).Worksheets("Pilotage").Cells(1, 1), Workbooks(classeur_courant).Worksheets("Pilotage").Cells(last_row_pil, last_col_pil))
    .Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Borders(xlEdgeTop).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Borders(xlEdgeRight).LineStyle = xlContinuous
    .Borders(xlInsideVertical).LineStyle = xlContinuous
    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
End With
Set dicofic = Nothing
End Sub

Le nom des clés sont du type : 999XX000009999999999BERNARD LAMA 1510161047xxExxx.xlsm

2eme Problème, quand je lance ma macro via le bouton, mes ecriture commence à la ligne mais en occultant certains fichiers, mais quand je passe en pas à pas j'ai bien toutes mes ecritures qui débutent à la premiere cellule non vide

Invité · 21/10/2015, 14h03

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

dicofic.Add ThisWorkbook.Sheets("Pilotage").Range("A" & j + 1), ThisWorkbook.Sheets("Pilotage").Range("A" & j + 1)

[XL2010] Probleme création dictionnaire

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager