Discussion :

[Passepartout007]

Bonjour j'ai résolu mon problème tout fonctionne bien voici le code:
j'ai mis NumColList ET NumColBase en integer en string cela fonctionne pas.

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
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
Public Feuillebase As String
Public FeuilleList As String
Public PlageBase As Range
Public Plagetype As Range
Public PlageList As Range
Public NumColList As Long
Public NumColBase As Long
Public Types As String
 
 
Sub actualisationlist()
Call listTypeFTS
Call listMaterielFTS
Call listTacheFTS
Call listVersionFTS
Call listObservationFTS
End Sub
Sub listTypeFTS()
Feuillebase = "Base de données"
FeuilleList = "ListesFTS"
Set Plagetype = ThisWorkbook.Sheets(Feuillebase).Range("C2:C" & Sheets(Feuillebase).[C1048576].End(xlUp).Row)
Set PlageBase = ThisWorkbook.Sheets(Feuillebase).Range("C2:C" & Sheets(Feuillebase).[C1048576].End(xlUp).Row)
Set PlageList = ThisWorkbook.Sheets(FeuilleList).Range("A2:A" & Sheets(FeuilleList).[A1048576].End(xlUp).Row)
Types = "FT"
 
Set MonTablo = ThisWorkbook.Sheets(FeuilleList).ListObjects("List_TypeFTS")
 
NumColList = 1
NumColBase = 3
Call Incementationlist
End Sub
Sub listMaterielFTS()
Feuillebase = "Base de données"
FeuilleList = "ListesFTS"
Set Plagetype = ThisWorkbook.Sheets(Feuillebase).Range("C2:C" & Sheets(Feuillebase).[C1048576].End(xlUp).Row)
Set PlageBase = ThisWorkbook.Sheets(Feuillebase).Range("D2:D" & Sheets(Feuillebase).[D1048576].End(xlUp).Row)
Set PlageList = ThisWorkbook.Sheets(FeuilleList).Range("B2:B" & Sheets(FeuilleList).[B1048576].End(xlUp).Row)
Types = "FT"
 
Set MonTablo = ThisWorkbook.Sheets(FeuilleList).ListObjects("List_MaterielFTS")
 
NumColList = 2
NumColBase = 4
Call Incementationlist
End Sub
Sub listTacheFTS()
Feuillebase = "Base de données"
FeuilleList = "ListesFTS"
Set Plagetype = ThisWorkbook.Sheets(Feuillebase).Range("C2:C" & Sheets(Feuillebase).[C1048576].End(xlUp).Row)
Set PlageBase = ThisWorkbook.Sheets(Feuillebase).Range("F2:F" & Sheets(Feuillebase).[F1048576].End(xlUp).Row)
Set PlageList = ThisWorkbook.Sheets(FeuilleList).Range("C2:C" & Sheets(FeuilleList).[C1048576].End(xlUp).Row)
Types = "FT"
Set MonTablo = ThisWorkbook.Sheets(FeuilleList).ListObjects("List_TacheFTS")
NumColList = 3
NumColBase = 6
Call Incementationlist
End Sub
Sub listVersionFTS()
Feuillebase = "Base de données"
FeuilleList = "ListesFTS"
Set Plagetype = ThisWorkbook.Sheets(Feuillebase).Range("C2:C" & Sheets(Feuillebase).[C1048576].End(xlUp).Row)
Set PlageBase = ThisWorkbook.Sheets(Feuillebase).Range("G2:G" & Sheets(Feuillebase).[G1048576].End(xlUp).Row)
Set PlageList = ThisWorkbook.Sheets(FeuilleList).Range("D2:D" & Sheets(FeuilleList).[D1048576].End(xlUp).Row)
Types = "FT"
Set MonTablo = ThisWorkbook.Sheets(FeuilleList).ListObjects("List_VersionFTS")
NumColList = 4
NumColBase = 7
Call Incementationlist
End Sub
 
Sub listObservationFTS()
Feuillebase = "Base de données"
FeuilleList = "ListesFTS"
Set Plagetype = ThisWorkbook.Sheets(Feuillebase).Range("C2:C" & Sheets(Feuillebase).[C1048576].End(xlUp).Row)
Set PlageBase = ThisWorkbook.Sheets(Feuillebase).Range("H2:H" & Sheets(Feuillebase).[H1048576].End(xlUp).Row)
Set PlageList = ThisWorkbook.Sheets(FeuilleList).Range("E2:E" & Sheets(FeuilleList).[E1048576].End(xlUp).Row)
Types = "FT"
Set MonTablo = ThisWorkbook.Sheets(FeuilleList).ListObjects("List_ObservationFTS")
NumColList = 5
NumColBase = 8
Call Incementationlist
End Sub
 
Sub Incementationlist()
Dim LList As Object
Dim X As String
Dim Cel As Range
Dim V1 As String
Dim V2 As String
Dim D As String
Dim c As Range
Dim Clear As String
Dim num As Long
Dim i As Long
Set LList = CreateObject("Scripting.Dictionary")   'Crée le répertoire
LList.CompareMode = TextCompare 'On rend le dictionnaire insensible aux majuscules minuscules
Clear = ThisWorkbook.Sheets(FeuilleList).Cells(Rows.Count, NumColList).End(xlUp).Row - 1
 
If ThisWorkbook.Sheets(FeuilleList).Cells(2, NumColList).Value <> "" Then
For i = Clear To 1 Step -1
MonTablo.ListRows(i).Delete
Next i
End If
    For Each Cel In Plagetype  'Pour tout les cellules de la colonne indiqué
    X = Cel.Row 'Prend le numéro de ligne de la cellule en cours de traitement
    V1 = ThisWorkbook.Sheets(Feuillebase).Cells(X, 3).Value ' V prend la valeur de la cellules indiqué
    If InStr(1, V1, Types) <> 0 Then
        V2 = ThisWorkbook.Sheets(Feuillebase).Cells(X, NumColBase).Value
        Set c = PlageList.Find(V2, LookIn:=xlValues, lookat:=xlWhole) ' C prend la valeur Nothing si il ne trouve rien sinon la valeur de la case
 
                'Si la valeur de la celulle n'existe pas dans le disctionnaire et qu'elle est différente de vide alors la copier dans le dictionnaire
                If c Is Nothing And Not LList.Exists(V2) Then ' Si C est rien et qu'il n'existe pas V dans la list LList alors
                    D = ThisWorkbook.Sheets(FeuilleList).Cells(Rows.Count, NumColList).End(xlUp).Row + 1 ' D prend la valeur de la dernier ligne disponible dans la plage
                    'ThisWorkbook.Sheets(FeuilleList).Cells(D, NumColList).Value = V2 'La cellule indique en D prend la valeur de V
                    LList.Add V2, V2 'ajoue de V dans la liste LList
                End If 'fin de si
    End If
        Next Cel 'cellule suivante
        i = 2
        For Each Item In LList
            ThisWorkbook.Sheets(FeuilleList).Cells(i, NumColList).Value = Item
            i = i + 1
            Next Item
'Début tris alphabétique de la list
Feuille = FeuilleList 'défini que feuille est "Toutes les Listes"
MaColonne = Sheets(Feuille).Cells(1, NumColList).Value  'Défini que la colonne est en B1
Call TriAlpha 'appel la macro TriAlpha
'Fin tris alphabétique de la list
 
End Sub 'fin de macro

Cependant avec cette macro j'ai un problème de lenteur ... Il y a t'il un moyen d'amélioré ses performance ?
Cordialement,
Passepartout007

J'ai résolut mon problème de lenteur en utilisant :

Ce code pour supprimer les éléments :

Code :

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

1
2
3
With MonTablo
If .ListRows.Count > 2 Then .DataBodyRange.Resize(.ListRows.Count - 1, .ListColumns.Count).Offset(1, 0).Delete
End With

et ce code pour les ajouter :

Code :

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

1
2
3
4
5
With MonTablo
        .Resize (.Parent.Range(.Range.Cells(1, 1).Address, .Range.Cells(1, 1).Offset(MonDico.Count, .ListColumns.Count - 1)))
        .ListColumns("Nomdemacolonne").DataBodyRange.Value = Application.Transpose(MonDico.keys)
 
    End With

Voila voila ,
Merci encore

[Qwazerty]

Salut

!! Que de messages!
Il faut absolument que tu édites tes messages lorsque tu arrives à résoudre tes problèmes car il est très compliqué de suivre et répondre à tant de choses.
De plus il serait bien sur des problèmes ponctuelles de créer un autre sujet, passé une disaines de messages dans une discution, je pense qu'il est très rare que des gens s'y intéressent, ça fait beaucoup trop de chose à lire pour essayer de comprendre ce qui s'y trouve.

Je vais essayer de répondre à une partie des questions mais il serait bien de prendre le réflexe de chercher sur le net et de faire des essais avec les espions par exemple (cf les histoire de numéro d'index, je te donne un exemple dans les réponses).

Dans ses appel je set l'userform que j'utilise (la page de l'userform) ici FTSSaisie ainsi que Le textbox que j'utilise.

Pour quelle raison souhaites tu passer par des variables? Les paramètre que tu passe à la procédure sont justement là pour ça, au lieu de passer Date1 as String, tu as tout autant intérêt à passer le Textbox qui contient cette date.

---

Code :

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

If Date1 Like "##-##-####" Then

Tu interdit donc toutes les dates de la forme #-##-#### ou ##-#-## ou #-#-#### ou ... personnelement je trouve dommage d'être si restrictif, c'est pour ça que j'avais fait un code mermettant de tester si la date et valider et était en format "JJ/MM/AA(AA)". A toi de voir à l'utilisation en fonction des retours que te feront les utilisateurs.

Code :

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

1
2
3
4
 With ThisWorkbook
   With UserformActif
        With TextBoxActif
            .Value = Replace(Date1, "-", "/")

Ici les deux 1ers with ne servent à rien seul le dernier est pris en compte, tu confonds avec une utilisation de ce type

Code :

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

1
2
3
4
5
With ThisWorkBook
 
    With .sheet("...")
 
        With .range("...")

De plus dans le cas d'un objet, il n'est pas utile de préciser toute la chaine pour que VBA sache que c'est de lui dont tu parles. C'est le principe de la programmation objet. Si dns un userform tu définis

Code :

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

Set MonTxtBox = TxtDate

MonTxtBox ne peut pas pointer un autre txtbox que TxtDate, il est donc inutile de lui rappeler qu'il se trouve dans userformActif ni dans thisworkbook.

Cette macro coloration fais appel à la macro DateValide pour savoir si la date est valide ou non :

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
If Not strDate Like "##/##/####" Then
 
    DateValide = False
Else
 
    'On extrait les 3 parties
    TabDate = Split(strDate, "/")
    YearValue = TabDate(2)
    MonthValue = TabDate(1)
    DayValue = TabDate(0)
    'On vérifie le retour de isdate()
        If YearValue < 1900 Then
            DateValide = False
        Else
            Select Case MonthValue
                Case 1, 3, 5, 7, 8, 10, 12
                    If DayValue > 31 Then DateValide = False
                Case 4, 6, 9, 11
                    If DayValue > 30 Then DateValide = False
                Case 2
                    If YearValue Mod 400 = 0 Or (YearValue Mod 100 <> 0 And YearValue Mod 4 = 0) Then
                        If DayValue > 29 Then DateValide = False
                    Else
                    If DayValue > 28 Then DateValide = False
                    End If
                Case Else
                    If strDate <> "" Then
                        DateValide = False
                    Else
                        DateValide = True
                    End If
            End Select
        End If
End If
If strDate Like "" Then DateValide = True
End Function

C'est toi qui voit, moi je suis pour ne pas mettre autant de contrôle de saisie mais c'est toi qui voit.

---

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
Public Function EnabeldBtValid()
Dim Ctrl As Control
Dim R As String
R = 0
With UserformActif
 
    For Each Ctrl In UserformActif.Controls
 
        With Ctrl
            If Ctrl.Tag = "Rouge" Then
                If .BackColor = &HFF& Then
 
                    R = R + 1
                End If
            End If
        End With
    Next Ctrl
        If R > 0 Then
            BTValidation.Enabled = False
        Else
            BTValidation.Enabled = True
        End If
 
End With
 
End Function

Pour la validation du bouton en effet pourquoi ne pas tester la couleur des champs par contre attention avec l'utilisation de Tag, je ne sais pas à quel moment tu le modifies mais si tag à un contenu "Rouge", ça veut dire que lorsque les autre procédure de filtrage qui regarde le contenu de tag pour connaitre la colonne sur laquelle ils doivent travailler tu vsa avoir des soucis...
Si tu veux utiliser tag pour plusieur utilisation différentes, il va falloir metrte en place une structure de son contenu bien plus complexe que de juste y déposer une valeur. Par exemple Couleur=Rouge;Colonne=Type et dans les procédures qui utilise tag il te faudra extraire ce dont tu as besoin. C'est un exemple, il paut y avoir bien plus de possibilité de faire c'est juste pour t'exposer un principe et te faire comprendre que l'utilisation de tag ne résoud pas tout

---

Pendant la saisie de la textbox :

Code :

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

1
2
3
Private Sub TextBoxArriv1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
TextBoxArriv1.Text = Insertslach(TextBoxArriv1.Text)
End Sub

A chaque appuis sur une touche cela fais appel à la macro Insertslach

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Public Function Insertslach(strDate As String) As String
 
Select Case Len(strDate)
 
        Case 2, 5
        strDate = strDate & "/"
        Insertslach = strDate
Case Else
    Insertslach = strDate
End Select
 
Suppr2 = Len(strDate)
 
End Function

Dante disait que l'enfer c'est la répétition, je pense qu'il ne connaissait pas la contraite exercée par ce type de code . Encore une fois, tu verras à l'utilisation mais pour moi un "bon" code, c'est un code qui permet de gérer tous les risques en imposant le moins de contraites possible à l'utilisateur. Les slash qui apparaisse de nul part, c'est super stressant pour moi. L'ahabitude fait que quand je tape une date machinalement je tape sur les "/" hors ici ton code n'en tient pas compte, ce qui veut dire que quand je vait taper sur "/", je vais avoir une date comme ça 01//05... pleures garantis.

Code :

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

1
2
 
Celle macro insert un slash à la saisie du 3eme et du 6eme caractère entre le deuxième caractère et le 3ème : on écris 12 puis on écris 3 automatiquement on n'auras 12/3. A la sortie de la textbox il y aura la vérification de la date pour vérifier que cela soit correct. Quand on supprime les caractère cela n'insert pas de slash car le nombre diminue et quand len = 2 on passe a len = 1 après.

et deux minutes après l'utilisateur passe sur un autre logiciel qui lui ne lui ajoutera pas les "/" tout seul. Je pense qu'il vaut mieux éviter de trop materner et infantilliser l'utlisateur. C'est comme un enfant il vaut mieux le surveiller et lu ilaisser faire des expérience quitte à intervenir en cas de risque plutôt que de lui dire où poser chaqu'un de ses pieds. Bon j'ai pas d'enfant mais tu comprendra la parabole

---

Pour la partie sur la génération des tableaux qui vont contenir les valeur qui seront utilisées dans les combo.
A mon avis tu te casses trop la tête. Imagine que tu nomme chaque tableau avec un nom proche de celui de la combo dont il va nourrire la liste. Par exemple pour la combobox CB_Type, tu crées sur ta feuille un tableau que tu nommes TBList_CB_Type. Dans l'entête de ce tableau tu mets Type. Et tu fais la même chose pour chaque Combo
Tu crées ensuite une boucle sur les composants du userform.
Si le tag du userform à un contenu, tu extrait le nom du champs, le code est déjà présent dans la macro FillList

Code :

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

NomColonne = Split(LeCombo.Tag, ";")(0)

Et il ne te manque plus qu'à pointer le tableau ou tu vas placer tes valeurs

Code :

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

with FeuilX.ListObjects("TBList" & LeCombo.name)

Tu vides le contenu du tableau et tu le remplis avec un code similaire à FillList

Tu peux aussi choisir de faire une liste Array contenant tous les champs dont tu veux faire la liste des valeurs uniques et ainsi au lieu de boucler sur les composant de ton userform, tu boucle sur le contenu de la liste Array

Mais à mon avis vu le temps mis par le code à remplire les listes... remplire des tableaux à part c'est prendre le risque de ne pas les mettre à jour au bon moment (à quel moment d'ailleurs??).
A l'ouverture? au bout de deux ajouts dans la base, les listes ne sont plus à jour.
Un bouton? Ca force l'utilisateur à se demander s'il à inscrit de nouvelles valeurs... il finira donc par lefaire systèmatiquement pour être sûr, ce qui à peu d'intérêt.

Si le contenu de la base peut varié une fois le userform ouvert, le mieux est de mettre à jour la liste au moment du clique sur le bouton de déroulement de la liste (de mémoire c'est le choix que tu avais fait au départ)

Code :

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

1
2
3
Private Sub CBoxUM_DropButtonClick()
    FillList CBoxUM
End Sub

Ca limite le temps de chargement du UserForm au début, ça évite de perdre du temps à charger des listes qui ne seront pas utilisées et ça permet d'être sûr que la liste correspond bien au contenu de la base

---

Actuellement je travail sur le double-clik sur la listview :
Bonjour,

J'ai un problème d'index dans une listview et je ne comprend pas pourquoi .

Code :

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

1
2
3
4
5
6
Private Sub LVResult_DblClick()
Dim ColumnHeader As MSComctlLib.ColumnHeader
Dim Var As String
Var = LVResult.SelectedItem.ListSubItems(0).Text
MsgBox Var
End Sub

Ici on pointe à la ligne sélectionnée la colonne en index (0) cela me met donc le message d'erreur 35600 Index out of bounds sur la ligne :

Code :

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

Var = LVResult.SelectedItem.ListSubItems(0).Text

Bien souvent lorsque tu as ce style d'erreur il faut imédiatement te demander sur quel base travaille ton tableau. Une collection ou un tableau peuvent être de base 0 ou 1, en base 0 l'index commence à... 0 et en base 1 à...1.
Si tu as un doute, soit tu regarde dans l'aide et c'est souvent indiqué. Soit si ça ne l'ai pas tu place un espion pour voir
Ici par exemple je regarde l'index du 1er item de columnHeaders

On voit de suite que l'index de l'item 1 est 1, on est donc en base 1, il est inutile d'espérer trouver un item(0)

---

Code :

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

1
2
3
4
5
            For Each Cel In PlageList
                 x = Cel.Row 'X est égale au numéro de ligne
                If Not LList.Exists(.Cells(x, NumColList).Value) And  (.Cells(x, NumColList).Value <> "") Then LList.Add .Cells(x,  NumColList).Value, .Cells(x, NumColList).Value
 
            Next Cel 'Cellule suivant

J'ai vu que tu faisais souvent ça dans tes boucles for, le fait de définir x et de ne pas utiliser Cel dans le suite. Si tu ne veux pas travailler avec l'objet range et que tu souhiates juste avoir la ligne correspondante, utilise for comme ça

Code :

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

1
2
3
with ThisWorkBook.Sheets(Feuillebase)
    for x = 2 to .cells(.rows.count,"A").end(xlup).row
'...

Par contre je ne comprends pas pourquoi tu t'embêtes à définir la plage de donnée, tu la connais, elle a un nom puisque c'est un tableau, autant utiliser son nom FeuilList.Listobjects("...").listcolumns("...").DatabodyRange

Bonjour j'ai résolu mon problème tout fonctionne bien voici le code:
j'ai mis NumColList ET NumColBase en integer en string cela fonctionne pas.

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
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
Public Feuillebase As String
Public FeuilleList As String
Public PlageBase As Range
Public Plagetype As Range
Public PlageList As Range
Public NumColList As Long
Public NumColBase As Long
Public Types As String
 
 
Sub actualisationlist()
Call listTypeFTS
Call listMaterielFTS
Call listTacheFTS
Call listVersionFTS
Call listObservationFTS
End Sub
Sub listTypeFTS()
Feuillebase = "Base de données"
FeuilleList = "ListesFTS"
Set Plagetype = ThisWorkbook.Sheets(Feuillebase).Range("C2:C" & Sheets(Feuillebase).[C1048576].End(xlUp).Row)
Set PlageBase = ThisWorkbook.Sheets(Feuillebase).Range("C2:C" & Sheets(Feuillebase).[C1048576].End(xlUp).Row)
Set PlageList = ThisWorkbook.Sheets(FeuilleList).Range("A2:A" & Sheets(FeuilleList).[A1048576].End(xlUp).Row)
Types = "FT"
 
Set MonTablo = ThisWorkbook.Sheets(FeuilleList).ListObjects("List_TypeFTS")
 
NumColList = 1
NumColBase = 3
Call Incementationlist
End Sub
Sub listMaterielFTS()
Feuillebase = "Base de données"
FeuilleList = "ListesFTS"
Set Plagetype = ThisWorkbook.Sheets(Feuillebase).Range("C2:C" & Sheets(Feuillebase).[C1048576].End(xlUp).Row)
Set PlageBase = ThisWorkbook.Sheets(Feuillebase).Range("D2:D" & Sheets(Feuillebase).[D1048576].End(xlUp).Row)
Set PlageList = ThisWorkbook.Sheets(FeuilleList).Range("B2:B" & Sheets(FeuilleList).[B1048576].End(xlUp).Row)
Types = "FT"
 
Set MonTablo = ThisWorkbook.Sheets(FeuilleList).ListObjects("List_MaterielFTS")
 
NumColList = 2
NumColBase = 4
Call Incementationlist
End Sub
Sub listTacheFTS()
Feuillebase = "Base de données"
FeuilleList = "ListesFTS"
Set Plagetype = ThisWorkbook.Sheets(Feuillebase).Range("C2:C" & Sheets(Feuillebase).[C1048576].End(xlUp).Row)
Set PlageBase = ThisWorkbook.Sheets(Feuillebase).Range("F2:F" & Sheets(Feuillebase).[F1048576].End(xlUp).Row)
Set PlageList = ThisWorkbook.Sheets(FeuilleList).Range("C2:C" & Sheets(FeuilleList).[C1048576].End(xlUp).Row)
Types = "FT"
Set MonTablo = ThisWorkbook.Sheets(FeuilleList).ListObjects("List_TacheFTS")
NumColList = 3
NumColBase = 6
Call Incementationlist
End Sub
Sub listVersionFTS()
Feuillebase = "Base de données"
FeuilleList = "ListesFTS"
Set Plagetype = ThisWorkbook.Sheets(Feuillebase).Range("C2:C" & Sheets(Feuillebase).[C1048576].End(xlUp).Row)
Set PlageBase = ThisWorkbook.Sheets(Feuillebase).Range("G2:G" & Sheets(Feuillebase).[G1048576].End(xlUp).Row)
Set PlageList = ThisWorkbook.Sheets(FeuilleList).Range("D2:D" & Sheets(FeuilleList).[D1048576].End(xlUp).Row)
Types = "FT"
Set MonTablo = ThisWorkbook.Sheets(FeuilleList).ListObjects("List_VersionFTS")
NumColList = 4
NumColBase = 7
Call Incementationlist
End Sub
 
Sub listObservationFTS()
Feuillebase = "Base de données"
FeuilleList = "ListesFTS"
Set Plagetype = ThisWorkbook.Sheets(Feuillebase).Range("C2:C" & Sheets(Feuillebase).[C1048576].End(xlUp).Row)
Set PlageBase = ThisWorkbook.Sheets(Feuillebase).Range("H2:H" & Sheets(Feuillebase).[H1048576].End(xlUp).Row)
Set PlageList = ThisWorkbook.Sheets(FeuilleList).Range("E2:E" & Sheets(FeuilleList).[E1048576].End(xlUp).Row)
Types = "FT"
Set MonTablo = ThisWorkbook.Sheets(FeuilleList).ListObjects("List_ObservationFTS")
NumColList = 5
NumColBase = 8
Call Incementationlist
End Sub
 
Sub Incementationlist()
Dim LList As Object
Dim X As String
Dim Cel As Range
Dim V1 As String
Dim V2 As String
Dim D As String
Dim c As Range
Dim Clear As String
Dim num As Long
Dim i As Long
Set LList = CreateObject("Scripting.Dictionary")   'Crée le répertoire
LList.CompareMode = TextCompare 'On rend le dictionnaire insensible aux majuscules minuscules
Clear = ThisWorkbook.Sheets(FeuilleList).Cells(Rows.Count, NumColList).End(xlUp).Row - 1
 
If ThisWorkbook.Sheets(FeuilleList).Cells(2, NumColList).Value <> "" Then
For i = Clear To 1 Step -1
MonTablo.ListRows(i).Delete
Next i
End If
    For Each Cel In Plagetype  'Pour tout les cellules de la colonne indiqué
    X = Cel.Row 'Prend le numéro de ligne de la cellule en cours de traitement
    V1 = ThisWorkbook.Sheets(Feuillebase).Cells(X, 3).Value ' V prend la valeur de la cellules indiqué
    If InStr(1, V1, Types) <> 0 Then
        V2 = ThisWorkbook.Sheets(Feuillebase).Cells(X, NumColBase).Value
        Set c = PlageList.Find(V2, LookIn:=xlValues, lookat:=xlWhole) ' C prend la valeur Nothing si il ne trouve rien sinon la valeur de la case
 
                'Si la valeur de la celulle n'existe pas dans le disctionnaire et qu'elle est différente de vide alors la copier dans le dictionnaire
                If c Is Nothing And Not LList.Exists(V2) Then ' Si C est rien et qu'il n'existe pas V dans la list LList alors
                    D = ThisWorkbook.Sheets(FeuilleList).Cells(Rows.Count, NumColList).End(xlUp).Row + 1 ' D prend la valeur de la dernier ligne disponible dans la plage
                    'ThisWorkbook.Sheets(FeuilleList).Cells(D, NumColList).Value = V2 'La cellule indique en D prend la valeur de V
                    LList.Add V2, V2 'ajoue de V dans la liste LList
                End If 'fin de si
    End If
        Next Cel 'cellule suivante
        i = 2
        For Each Item In LList
            ThisWorkbook.Sheets(FeuilleList).Cells(i, NumColList).Value = Item
            i = i + 1
            Next Item
'Début tris alphabétique de la list
Feuille = FeuilleList 'défini que feuille est "Toutes les Listes"
MaColonne = Sheets(Feuille).Cells(1, NumColList).Value  'Défini que la colonne est en B1
Call TriAlpha 'appel la macro TriAlpha
'Fin tris alphabétique de la list
 
End Sub 'fin de macro

Cependant avec cette macro j'ai un problème de lenteur ... Il y a t'il un moyen d'amélioré ses performance ?
Cordialement,
Passepartout007

Même remarque qu'au début, il faut travailler ton code pour qu'il soit polyvalent, tu as x fois le même code qui fait x fois les mêmes choses.
Crées une procédure globale, donne lui les paramètre dont elle a besoin, ne crées pas tout un tas de variabales globales, utilises plutôt des paramètres que tu passes à tes sub/fonction.
Quand je veux faire un procédure commune je me dis (imprime ta procédure et passe au fluo si besoin)
Quelles parties du code sont identiques (-> une couleur)
Quelles parties sont variables (-> autre couleur)
Sur les parties variables, de quoi est-je besoin?

Par exmple le nom du combobox sur lequel je travailles, OK alors je rajoute un paramètre à ma procédure avec un combobox)

J'ai besoin d'une plage de cellule qui se trouve dans un tableau structuré, donc j'ajoute un listColumn en paramètre



J'espère que ça t'aidera.
Un conseil à ce stade, cré d'autre file de discution pour les raison invoquer plus haut et de plus n'y vois aucune offence, le sujet me lasse un peu .

Bonne continuation

++
Qwaz

[Passepartout007]

Bonjour,

Merci pour tes retours cela rend plus claire les choses.

J'essaye déjà de généraliser mes macros, et cela de plus en plus. Je n'ais pas encore assez de niveau en VBA, (je débute) pour réussir à généraliser autant que toi. Cela viendras avec le temps.
Pour l'actualisation des listes je le ferais surement entre un passage de accueil à un userfom nécessitant des listes actualisées. (l'incrémentation ce fais maintenant rapidement) voir le sujet :
https://www.developpez.net/forums/d1.../#post10373590

Je comprend bien ce que tu me dis et il est vrais que la lisibilité de la discutions à diminuer. Il me reste une partie non résolut. Le problème au double clic sur la listview.
Je t'invite à me répondre sur un autre sujet de discutions créer pour ce sujet.

Voici le liens : https://www.developpez.net/forums/d1.../#post10372839

Je répondrais la-bas à ton message.

Cordialement,
Passepartout007

[clementmarcotte]

Bonjour,

Bonjour,

Je n'ais pas encore assez de niveau en VBA, (je débute) pour réussir à généraliser autant que toi.Passepartout007

Avant de faire de la course de haies, il faut apprendre à marcher. On ne choisit pas l'Everest comme premier projet. Le Mont-Royal, cela aurait été en masse.


Et je suis toujours d'accord avec la dernière de ma signature.

[Passepartout007]

Bonjour,



Avant de faire de la course de haies, il faut apprendre à marcher. On ne choisit pas l'Everest comme premier projet. Le Mont-Royal, cela aurait été en masse.

Salut Clementmarcotte je sais bien, mais ce n'est pas moi qui est choisi le sujet on me l'a imposer, et celui-ci est nécessaire pour l'entreprise. Je préfère donc malgré la complexité du sujet essayer de bien faire les choses.
Mais je te remercie pour ton conseil.
Cordialement,
Passepartout007