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
| Sub MiseEnFormeFind()
Dim DateNet As Date, Cherche As String
Dim MaPlage As Range, DerLig As Integer, i, j As Integer, Ligne As Integer
Dim Sup12 As Variant
Dim Couleur As Variant, CouleurSup12 As Variant
On Error Resume Next
'on efface les anciennes couleurs
Sheets("dépôt").Range("1:90").Interior.ColorIndex = xlColorIndexNone
'on boucle dans les feuilles nommées cellule*
For i = 1 To 4
Sheets("cellule" & i).Activate
Cells.Interior.ColorIndex = xlColorIndexNone ' suppression couleurs précedentes
DerLig = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row 'on determine la derniere ligne
MaPlage = Range("B95:B" & DerLig) ' on declare la plage
For Ligne = 98 To DerLig 'on passe toutes lees cles de la plage en revu
Cherche = Sheets("cellule" & i).Range("B" & Ligne).Value ' valeur à chercher
Trouve = Sheets("cellule" & i).Range("C3:DN90").Find(Cherche, , LookAt:=xlWhole).Address 'on cherche dans la feuille("cellule"i)
TrouveD = Sheets("dépôt").Range("C3:IJ90").Find(Cherche, , LookAt:=xlWhole).Address 'on cherche dan la feuille depot
DateNet = Range("E" & Ligne) ' on recupere la date
' declaration des couleurs
Couleur = Sheets("dépôt").Range("BK96").Offset(0, j).Interior.Color
CouleurSup12 = Sheets("dépôt").Range("BK96").Offset(0, 48).Interior.Color
j = DateDiff("m", DateNet, Date)
' on colore la cellule en fonction de la date
If j > Sheets("dépôt").Range("DF94") Then
Sheets("cellule" & i).Range(Trouve, Trouve).Interior.Color = CouleurSup12
Sheets("dépôt").Range(TrouveD, TrouveD).Interior.Color = CouleurSup12
Else
j = j * 4
Sheets("cellule" & i).Range(Trouve, Trouve).Interior.Color = Couleur
Sheets("dépôt").Range(TrouveD, TrouveD).Interior.Color = Couleur
End If
Next
Next
Sheets("dépôt").Select
End Sub |
Partager