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
| Option Explicit
Sub Gaston64()
'déclaration des variables
Dim f0 As Worksheet, f1 As Worksheet
Dim Cel As Range, MaPlage As Range
Dim Dico As Object, Tabl()
Dim Dico2 As Object
Dim i As Long
Dim Valeur
Dim cible
'affectation des objets aux variables
Set Dico = CreateObject("Scripting.Dictionary")
Set Dico2 = CreateObject("Scripting.Dictionary")
Set f0 = Sheets("Mängelliste")
Set f1 = Sheets("temp")
i = 1
'Liste sans doublon + Nombre d'occurence + remplissage Tabl des données Col T & U
With f0
'l'avantage de SpecialCells(xlCellTypeVisible) est d'éviter le test If .Hidden = False Then
Set MaPlage = .Range("T10", .Range("T" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
For Each Cel In MaPlage '<== Boucle
Dico(Cel.Value) = Dico(Cel.Value) + 1
ReDim Preserve Tabl(1 To 3, 1 To i) '<== redimensionnement et enregistrement de la variable tableau
Tabl(1, i) = Cel.Value '<== remplissage tableau dimension 1
Tabl(2, i) = Cel.Offset(, 6).Value '<== remplissage tableau dimension 2
If Cel.Offset(, 6).Value = "" Then
Tabl(3, i) = 1
End If
i = i + 1
Next Cel
End With
'tri du tableau selon ordre decroissant des valeurs de la colonne2 du Tabl
'Ce morceau de code est certainement à inclure quelque part plus haut, mais où?
' Do
' Valeur = 0
' For i = 1 To UBound(Tabl)
' If Tabl(2, i) < Tabl(2, i + 1) Then
' cible = Tabl(2, i)
' Tabl(2, i) = Tabl(2, i + 1)
' Tabl(2, i + 1) = cible
' Tabl(1, i + 1) = Tabl(1, i)
' Valeur = 1
' End If
' Next i
' Loop While Valeur = 1
' For i = 0 To UBound(Tabl)
' Debug.Print Tabl(1, i)
' Debug.Print Tabl(2, i)
' Next i
'Restitution de la liste sans doublons + Nbre d'occurences
f1.Range("FJ2").Resize(Dico.Count, 1) = Application.Transpose(Dico.keys)
f1.Range("FK2").Resize(Dico.Count, 1) = Application.Transpose(Dico.Items)
'test si date
'on voit ici l'intérêt d'avoir remplit notre variable tableau
'dans la boucle ci-dessus
For i = LBound(Tabl, 2) To UBound(Tabl, 2)
If IsDate(Tabl(2, i)) Then
'If (Tabl(2, i)) = "" Then
'si oui le nombre d'occurence = Nbre d'occurence total
Dico(Tabl(1, i)) = Dico(Tabl(1, i))
Dico2(Tabl(1, i)) = Dico2(Tabl(1, i))
Else
'si pas date ==> nombre d'occurence = Nbre d'occurence - 1
Dico(Tabl(1, i)) = Dico(Tabl(1, i)) - 1
Dico2(Tabl(1, i)) = Dico2(Tabl(1, i)) + 1
End If
Next i
'restitution du nombre de dates par item de liste
f1.Range("FL2").Resize(Dico.Count, 1) = Application.Transpose(Dico.Items)
f1.Range("FM2").Resize(Dico2.Count, 1) = Application.Transpose(Dico2.Items)
'vidage de la mémoire "effacement" des objets déclarés et affectés en début de procédure
Set Dico = Nothing
Set f0 = Nothing
Set f1 = Nothing
Set MaPlage = Nothing
End Sub |
