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
| Private Sub UserForm_Initialize() 'à l'initialsation de l'UserForm
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim K As Integer 'déclare la variable K (incrément)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim O As Worksheet 'déclare la variable O (Onglets)
Dim PL As Range 'déclare la variable PL (PLage)
Dim TC As Variant 'déclare la variable TC (Tableau de Cellules)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim NOC As Integer 'déclare la variable NOC (Nombre d'OCcurrences)
Dim R As Range 'décalare la variable R (Recherche)
Dim PA As String 'déclare la varoabe PA (Première Adresse)
TV = Array("a", "r", "f", "y", "u", "i", "j", "s", "z") 'définit le tableau de valeurs TV
K = 1 'initialise la variable K
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For Each O In Sheets 'boucle 1 : sur tous les onglets O du classeur
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
Set PL = Application.Intersect(O.Range("B1:E1").EntireColumn, O.UsedRange.Rows) 'définit la plage PL dans l'onglet O
If PL.Cells.Count > 1 Then 'condition 1 : si la plage PL contient plus d'une seule cellule (génère une erreur si la plage PL est vide)
If Err <> 0 Then 'condition 2 : si une erreur a été générée
Err.Clear 'supprime l'erreur
GoTo suite 'va à l'étiquette "suite"
End If 'fin de la condition 2
On Error GoTo 0 'annule la gestion des erreurs
TC = PL 'définit le tableau de cellules TC
For I = 1 To UBound(TC, 1) 'boucles 2 : sur toutes les lignes I du tableau de cellules TC
For J = 0 To 8 'boucles sur les 9 valeurs du tableau des valeurs TV
If TC(I, 1) = TV(J) Then 'si la valeur ligne I colonne 1 de TC est égale à la valeur J de TV
D(TC(I, 1)) = "" 'alimente le dictionnaire D avec la valeur ligne I, colonne 1
NOC = Application.WorksheetFunction.CountIf(O.Columns(2), TC(I, 1)) 'définit la variable NOC
Select Case NOC 'agit en fonction de la valeur variable NOC
Case 1 'si NOC vaut 1
ReDim Preserve TT(2, 1 To K) 'redimensionne le tableau de types TT
TT(0, K) = O.Name 'récupère le nom de l'onglet dans la première ligne du tableau de types TT
'récupère le numéro de ligne du type dans la seconde ligne du tableau de types TT
TT(1, K) = O.Columns(2).Find(TC(I, 1), , xlValues, xlWhole).Row
TT(2, K) = TC(I, 1) 'récupère le type dans la troisième ligne du tableau de types TT
K = K + 1 'incrémente K (rajoute une colonne au tableau de types TT)
Case Else 'tous les autres cas
Set R = O.Columns(2).Find(TC(I, 1), , xlValues, xlWhole) ''définit la recherche R
If Not R Is Nothing Then 'condition : si il existe au moins une occurrence trouvée
PA = R.Address 'définit l'adresse de la première occurrence trouvée
Do 'exécute
ReDim Preserve TT(2, 1 To K) 'redimensionne le tableau de types TT
TT(0, K) = O.Name 'récupère le nom de l'onglet dans la première ligne du tableau de types TT
TT(1, K) = R.Row 'récupère le numéro de ligne de l'occurrence trouvée
TT(2, K) = O.Cells(R.Row, 2) 'récupère le type
K = K + 1 'incrémente K
Set R = O.Columns(2).FindNext(R) 'redéfinit la recherche R (occurrence suivante)
'boucle tant qu'il existe de nouvelle occurrences ailleurs qu'en PA
Loop While Not R Is Nothing And R.Address <> PA
End If 'fin de la condition
End Select 'fin de l;'action en fonction de la valeur de la variable NOC
End If 'fin de la condition 3
Next J
Next I 'prochaine ligne de la boucle 2
End If 'fin de la condition 1
suite: 'étiquette
On Error GoTo 0 'annule la gestion des erreurs
Next O 'prochain onglet de la boucle 1
Me.ComboBox1.List = D.keys 'alimente la ComboBox1 avec la liste des éléments du dictionnaire D sans doublon
Me.ComboBox1.ListIndex = 0 'affiche le premier élément de la liste
For I = 1 To UBound(TT, 2) 'boucle sur toutes les colonnes I du tableau de types TT
If CStr(TT(2, I)) = Me.ComboBox1 Then 'condition : si la valeur ligne 2 colonne I de TT est égale à la valeur de la ComboBox1
With Me.TextBox1 'prend en compte la TextBox1
.Value = Sheets(TT(0, I)).Cells(TT(1, I), 5).Value 'récupère le prix correspondant
.SetFocus 'place le curseur
.SelStart = 0 'début de la sélection
.SelLength = Len(.Value) 'longueur de la sélection
End With 'fin de la prise en compte de la TextBox1
Sheets("Feuil1").Select 'sélectionne l'onglet "Feuil1
Exit Sub 'sort de la procédure
End If 'fin de la condition
Next I 'prochaine colonne de la boucle
End Sub |
