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
|
Option Explicit
Public MatriceReferences() As Variant
Public IndexMatrice As Integer
Sub RechercherLesReferences()
Dim ShReferences As Worksheet, ShDonnees As Worksheet
Dim AireReferences As Range, AireDonnees As Range
Dim I As Long, J As Long, DerniereLigneReference As Long, DerniereLigneDonnees As Long
Dim JeuDOnglets As Integer
Dim ReferenceMax As String
Erase MatriceReferences
JeuDOnglets = Sheets.Count
Sheets("Ce que j'ai (Feuil2)").Copy After:=Sheets(JeuDOnglets)
Set ShReferences = ActiveSheet
With ShReferences
.Name = "Références " & Format(JeuDOnglets, "00")
DerniereLigneReference = .Cells(.Rows.Count, "B").End(xlUp).Row
Set AireReferences = .Range(.Cells(4, 2), .Cells(DerniereLigneReference, 2))
End With
Sheets("Ce que j'ai (Feuil1)").Copy After:=Sheets(JeuDOnglets)
Set ShDonnees = ActiveSheet
With ShDonnees
.Name = "Data " & Format(JeuDOnglets, "00")
DerniereLigneDonnees = .Cells(.Rows.Count, "B").End(xlUp).Row
Set AireDonnees = .Range(.Cells(3, 2), .Cells(DerniereLigneDonnees, 2))
IndexMatrice = 0
For J = 1 To AireReferences.Count
If PresenceAsterisque(AireReferences(J)) Then
RechercheReferenceAvecAsterisque AireDonnees, AireReferences(J)
Else
RechercheReferenceSansAsterisque AireDonnees, AireReferences(J)
End If
Next J
End With
If IndexMatrice > 0 Then
ReferenceMax = ""
For IndexMatrice = LBound(MatriceReferences) To UBound(MatriceReferences)
If MatriceReferences(IndexMatrice) > ReferenceMax Then
ReferenceMax = MatriceReferences(IndexMatrice)
End If
Next IndexMatrice
For I = 1 To AireReferences.Count
With AireReferences(I)
If Mid(.Value, 1, Len(.Value) - 1) = Mid(ReferenceMax, 1, Len(ReferenceMax) - 1) Then
AireReferences(I) = ReferenceMax
End If
End With
Next I
End If
Set ShReferences = Nothing
Set ShDonnees = Nothing
Set AireReferences = Nothing
Set AireDonnees = Nothing
End Sub
Function PresenceAsterisque(ByVal Chaine As String) As Boolean
PresenceAsterisque = False
If InStr(1, Chaine, "*", vbTextCompare) > 0 Then PresenceAsterisque = True
End Function
Function RechercheReferenceAvecAsterisque(ByVal AireDonnees2 As Range, ByVal ReferenceAChercher As String) As String
Dim I As Long
RechercheReferenceAvecAsterisque = ""
For I = 1 To AireDonnees2.Count
With AireDonnees2(I)
If .Value <> "" Then
If Mid(.Value, 1, Len(.Value) - 1) = Mid(ReferenceAChercher, 1, Len(ReferenceAChercher) - 1) Then
RechercheReferenceAvecAsterisque = .Value
.Interior.Color = RGB(112, 48, 160)
.Font.Color = RGB(255, 255, 255)
.Font.Bold = True
ReDim Preserve MatriceReferences(IndexMatrice) ' Pour restituer la référence la plus grande
MatriceReferences(IndexMatrice) = .Value
IndexMatrice = IndexMatrice + 1
End If
End If
End With
Next I
End Function
Function RechercheReferenceSansAsterisque(ByVal AireDonnees2 As Range, ByVal ReferenceAChercher As String) As String ' Restitue la référence la plus grande
Dim I As Long
RechercheReferenceSansAsterisque = ""
For I = 1 To AireDonnees2.Count
With AireDonnees2(I)
If .Value = ReferenceAChercher Then
RechercheReferenceSansAsterisque = .Value
.Interior.Color = RGB(112, 48, 160)
.Font.Color = RGB(255, 255, 255)
.Font.Bold = True
End If
End With
Next I
End Function |
Mettre en forme certaines cellules d'une colonne par vba.
Répondre avec citation
Envoyé par Linkay
Partager