XL 2010 Recherche de la valeur de cellule de couleur

Samtchevsky

XLDnaute Nouveau
Bonjour,

Je possède un fichier avec plusieurs classeurs dont le dernier doit me permettre de faire un récapitulatif.

Je souhaiterais dans l'idéal que dans mon dernier onglet "RdG" la cellule C6 aille chercher la valeur de la dernière cellule à fond vert dans le premier onglet dans les cellules D à G en fonction du nom du site en B3 de l'onglet "RdG".

Je ne sais pas si je me suis bien fait comprendre!!!

Merci de votre aide.
 

Pièces jointes

  • Fichier.xlsm
    61.8 KB · Affichages: 101

Paf

XLDnaute Barbatruc
Bonjour Samtchevsky,

un essai par fonction personnalisée vérifiée sur C6:C12, à tester :

En C6: =DerVert($B$3) à tirer vers le bas

Dans un module standard:

VB:
Function DerVert(Site)
Dim PlageInstallation As Range, Installation As Range
Dim PlageSite As Range, SSite As Range, OK As Boolean, Col As Integer
With Worksheets("Planning maintenance régl.")

Set PlageSite = .Range("C4:C" & .Range("C" & Rows.Count).End(xlUp).Row - 2)
Set SSite = PlageSite.Find(Site, LookIn:=xlValues)
If SSite Is Nothing Then
    DerVert = "Site non référencé"
    Exit Function
End If
Set PlageInstallation = .Range("D1:DF1")
Set Installation = PlageInstallation.Find(Application.ThisCell.Offset(, -1), LookIn:=xlValues)
If Installation Is Nothing Then
    DerVert = "Installation Inconnue"
    Exit Function
End If
For Col = Installation.Column + 3 To Installation.Column Step -1
    If .Cells(SSite.Row, Col).Interior.ColorIndex = 43 Then
        OK = True
        Exit For
    End If
Next

If OK Then
    DerVert = .Cells(SSite.Row, Col)
Else
    DerVert = "aucune visite"
End If
End With
End Function

Peut-être adapter l'index de la couleur verte ( ici 43)

A+
 

Samtchevsky

XLDnaute Nouveau
Ca marche super bien. Merci beaucoup.
Maintenant, j'aimerais que ça fasse de même pour les cellules de l'onglet "RdG" C21 et C22 qui correspondent à l'onglet "Planning maintenance régl.>1 an" et les cellules C23 à 31 qui correspondent au second onglet.

C'est possible?
 

Paf

XLDnaute Barbatruc
re,

Pour les cellules C21 et C22, la structure de la feuille "Planning maintenance régl.>1 an" étant légèrement différente, il y avait le choix soit d'écrire une nouvelle fonction, soit d'adapter la première pour prendre en compte les différences entre feuilles.

Ci-dessous l'adaptation en une seule fonction:

Pour les cellules faisant référence à la feuille Planning maintenance régl.
=DerVert("Planning maintenance régl.";$B$3)

Pour les cellules faisant référence à la feuille Planning maintenance régl.>1 an
=DerVert("Planning maintenance régl.>1 an";$B$3)

la fonction:

VB:
Function DerVert(Feuille As String, Site As Range)
Dim PlageInstallation As Range, Installation As Range, Init As Byte, Décal As Byte
Dim PlageSite As Range, SSite As Range, OK As Boolean, Col As Integer
With Worksheets(Feuille)

Set PlageSite = .Range("C4:C" & .Range("C" & Rows.Count).End(xlUp).Row - 2)
Set SSite = PlageSite.Find(Site, LookIn:=xlValues)
If SSite Is Nothing Then
    DerVert = "Site non référencé"
    Exit Function
End If
Set PlageInstallation = .Range("D1:DF1")
Set Installation = PlageInstallation.Find(Application.ThisCell.Offset(, -1), LookIn:=xlValues)
If Installation Is Nothing Then
    DerVert = "Installation Inconnue"
    Exit Function
End If

Init = Installation.Column
Décal = .Index

For Col = Init + (3 * Décal) To Init Step -Décal
    If .Cells(SSite.Row, Col).Interior.ColorIndex = 43 Then
        OK = True
        Exit For
    End If
Next

If OK Then
    DerVert = .Cells(SSite.Row, Col)
Else
    DerVert = "aucune visite"
End If
End With
End Function

l'adaptation à la structure des feuilles est basé sur l'index de ces feuilles. Tout changement dans la position de ces feuilles (insertion ou suppression de feuille) ruineraient le fonctionnement de la fonction.

Pour les cellules C23 à C31, la recherche des intitulés colonne B ( feuille RdG) en ligne 1 (feuille Planning maintenance régl. ASC) et celle des types de visites doivent être sérieusement adaptées. Pour ne pas faire 'd'usine à gaz' il y aurait lieu de créer une nouvelle fonction.
Partant de la fonction existante, je vous invite à vous y pencher.

A+
 

Samtchevsky

XLDnaute Nouveau
Bonjour,

Merci de votre retour.
J'ai adapté le tableau pour simplifier la recherche et garder la même macro
Pour finir, j'aimerais différencier le "Non réalisé" du "Non concerné" qui lui est en de couleur grise (15).

Pourriez vous me conseiller un bon site/bouquin pour apprendre le vba? J'ai des bases, j'arrive à lire la macro mais de la à la construire ou à la modifier!!!

Cordialement.
 

Pièces jointes

  • Fichier v1.xlsm
    66.4 KB · Affichages: 36

Paf

XLDnaute Barbatruc
Re,

l'adaptation pour le type appareil élévateur ne peut pas être aussi simple. suivant le type de visite, il faut balayer 12 ou 9 ou 2 ou 1 colonnes pour trouver la cellule verte.

Votre modification dans les entêtes de colonnes a bien simplifié l'écriture du code.

Une fonction spécifique pour appareil élévateur:

en C23 : =VisiteElevateur($B$3) à tirer vers le bas

VB:
Function VisiteElevateur(Site As Range)
Dim PlageInstallation As Range, Installation As Range, Init As Byte, Décal As Byte
Dim PlageSite As Range, SSite As Range, OK As Boolean, Col As Integer, Pas as byte
Dim TypeV As String, TypeM As String, Temp
With Worksheets("Planning maintenance régl. ASC")

'* Recherche de la ligne du site
Set PlageSite = .Range("C4:C" & .Range("C" & Rows.Count).End(xlUp).Row - 2)
Set SSite = PlageSite.Find(Site, LookIn:=xlValues)
If SSite Is Nothing Then
    VisiteElevateur = "Site non référencé"
    Exit Function
End If
'* Recherche de la colonne du type de visite
Set PlageInstallation = .Range("D1:FO1")
Set Installation = PlageInstallation.Find(Application.ThisCell.Offset(, -1), LookIn:=xlValues)
If Installation Is Nothing Then
    VisiteElevateur = "Maintenance inconnue"
    Exit Function
End If
'* définition des paramètres
Init = Installation.Column ' N° de colonne de début de plage 
Temp = Split(Installation, "(")  'création d'un tableau des éléments séparée par "("
TypeV = Left(Temp(1), Len(Temp(1)) - 1) ' récupération du type de visite
TypeM = Trim(Split(Temp(0), ":")(1))     ' récupération du type de matériel
Select Case TypeV
    Case "Toutes les 6 semaines" 
        If TypeM = "Ascenseurs" Then
            Décal = 32   'nombre de colonnes entre le début et la fin de plage de cellule
        Else
            Décal = 44  'nombre de colonnes entre le début et la fin de plage de cellule
        End If
        pas = 4    ' espacement des cellules intéressantes
    Case "Semestrielle"
        Décal = 4: pas = 4
    Case Else
        Décal = 0: pas = 0
End Select

If pas = 0 Then ' cas des visites annuelles = 1 seule cellule
    If .Cells(SSite.Row, Init).Interior.ColorIndex = 43 Then OK = True
Else
    For Col = Init + Décal To Init Step -pas
        If .Cells(SSite.Row, Col).Interior.ColorIndex = 43 Then
            OK = True
            Exit For
        End If
    Next
End If
If OK Then
    VisiteElevateur = .Cells(SSite.Row, Col)
Else
    VisiteElevateur = "Non réalisé"
End If
End With
End Function

Quant aux bouquins, trop peu d'expérience dans ce domaine pour conseiller.

Pour les sites, il en existe une multitude, plus ou moins pédagogique, plus ou moins complet, plus ou moins pratique...

l'incontournable http://boisgontierjacques.free.fr/
https://web.archive.org/web/20150919082310/http://www.excelabo.net/
http://ericrenaud.fr/
http://lecompagnon.info/vba-excel/index.html
http://silkyroad.developpez.com/

et bien d'autres notamment en anglais.

et bien sûr sur ce site les Tutoriaux et Tutoriels

Bon courage

A+
 

Samtchevsky

XLDnaute Nouveau
Bonjour,

J'ai un souci concernant les ascenseurs. Il doit y avoir un problème sur la macro au niveau du calcul pour l'annuel. je n'arrive pas à trouver d'où vient le problème, je pensais à la multiplication des "If"?

De plus j'ai recopier cette formule (en apportant bien évidemment des modifications) pour calculer les maintenances planifiées, malheureusement, le résultats est la dernière cellule sans remplissage et avec une date du tableau alors que je souhaiterais dans ce cas que ce soit la première.

Une idée?

Cordialement.
 

Pièces jointes

  • Fichier v1.xlsm
    80.1 KB · Affichages: 39

Paf

XLDnaute Barbatruc
Re,

J'ai un souci concernant les ascenseurs. Il doit y avoir un problème sur la macro au niveau du calcul pour l'annuel. je n'arrive pas à trouver d'où vient le problème, je pensais à la multiplication des "If"?

Pas vu lors de mes tests, ça ne pouvait pas marcher, la variable Col n'est pas définie dans ce cas précis.

Dans la macro du post 6, au lieu de :
Code:
If pas = 0 Then ' cas des visites annuelles = 1 seule cellule
   If .Cells(SSite.Row, Init).Interior.ColorIndex = 43 Then OK = True
Else

mettre:
Code:
If Pas = 0 Then ' cas des visites annuelles = 1 seule cellule
  If .Cells(SSite.Row, Init).Interior.ColorIndex = 43 Then
     OK = True
     Col = Init
  End If
Else


De plus j'ai recopier cette formule (en apportant bien évidemment des modifications) pour calculer les maintenances planifiées...

Ne sachant pas ce qu'est une maintenance planifiée ni surtout comment la calculer, je n'ai pas regardé l'ajout de code...
La fonction est prévu pour afficher la maintenance réalisée. S'il s'agit d'afficher ( dans la même cellule ??) la date de la prochaine visite, on peut se servir de cette fonction comme base, encore faut-il connaitre les règles à appliquer .


A+
 
Dernière édition:

Samtchevsky

XLDnaute Nouveau
Bonjour,
Merci le modification a fonctionnée.

Concernant la maintenance planifié, c'est la date qui est dans la cellule sans remplissage. J'ai donc réutilisé votre code en faisant une modification afin de chercher les cellules sans remplissage et avec une valeur non nul:

Code:
If Pas = 0 Then ' cas des visites annuelles = 1 seule cellule
    If (.Cells(SSite.Row, Init).Interior.ColorIndex = xlNone And .Cells(SSite.Row, Init) <> "") Then OK8 = True
    Col = Init
Else
     For Col = Init + Décal To Init Step -Pas
         If (.Cells(SSite.Row, Col).Interior.ColorIndex = xlNone And .Cells(SSite.Row, Col) <> "") Then
         OK8 = True
             Exit For
         End If

Mais en réutilisant votre code, il va me chercher la dernière cellule de la ligne concerncée et non la cellule juste après la cellule verte.
Par exemple pour le site de Valence, j'aimerai chercher la date du 08/09/2016 mais la macro va chercher celle du 01/12/2016.
 

Pièces jointes

  • Fichier v1.xlsm
    79.7 KB · Affichages: 40

Paf

XLDnaute Barbatruc
re,

S'agissant initialement de chercher la dernière cellule verte d'une plage, on boucle sur cette plage en commençant par la fin :
For Col = Init + Décal To Init Step -Pas

S'il faut trouver la première cellule non vide et sans couleur, il faut commencer par le début et utiliser:
For Col = Init To Init + Décal Step Pas

A+
 

Samtchevsky

XLDnaute Nouveau
Magnifique!!!

J'arrive à la fin de ce que je souhaite faire.
J'ai un bug concernant la macro DerVert car dans le premier onglet il y a trois maintenances ou il y a une liste d'équipement et donc des colonnes masquées.

J'ai réutilisé et simplifié le code fourni pour les ascenseurs et j'ai nommé cette macro DerVertDisc et cela fonctionne.
J'ai voulu faire ma macro DerVertNoneDisc afin de pouvoir avoir comme pour les ascenseurs la date de planification. Mais cela me mets un #VALEUR!

Je joins le fichier mais voici le code:
Code:
Function DerVertNoneDisc(Site As Range)
Dim PlageInstallation As Range, Installation As Range, Init As Byte, Décal As Byte
Dim PlageSite As Range, SSite As Range, OK12 As Boolean, OK13 As Boolean, Col As Integer, Pas As Byte
Dim TypeV As String, TypeM As String, Temp
With Worksheets("Planning maintenance régl.")

'* Recherche de la ligne du site
Set PlageSite = .Range("C4:C" & .Range("C" & Rows.Count).End(xlUp).Row - 2)
Set SSite = PlageSite.Find(Site, LookIn:=xlValues)
If SSite Is Nothing Then
     DerVertNoneDisc = "Site non référencé"
     Exit Function
End If
'* Recherche de la colonne du type de visite
Set PlageInstallation = .Range("D1:FO1")
Set Installation = PlageInstallation.Find(Application.ThisCell.Offset(, -1), LookIn:=xlValues)
If Installation Is Nothing Then
     DerVertNoneDisc = "Maintenance inconnue"
     Exit Function
End If
'* définition des paramètres
Init = Installation.Column ' N° de colonne de début de plage
Temp = Split(Installation, "(")  'création d'un tableau des éléments séparée par "("
TypeM = Trim(Split(Temp(0), ":")(1))     ' récupération du type de matériel
TypeM = "Disconnecteur"
        Décal = 9: Pas = 3   'nombre de colonnes entre le début et la fin de plage de cellule: espacement des cellules intéressantes
For Col = Init To Init + Décal Step Pas
    If (.Cells(SSite.Row, Col).Interior.ColorIndex = xlNone And .Cells(SSite.Row, Col) <> "") Then
    OK12 = True
    Exit For
    End If
Next
If OK12 Then
     DerVertNoneDisc = .Cells(SSite.Row, Col)
End If
End With
End Function

Une fois que j'ai ça, je pourrais modifier la valeur de TypeM pour les deux autres maintenances et le tour sera joué^^
 

Pièces jointes

  • Fichier v1.xlsm
    85.4 KB · Affichages: 38

Paf

XLDnaute Barbatruc
re,

je venais de rédiger mon message pour vous signaler ce décalage à -5 au lieu de -1, quand un plantage (?) m'a fait perdre la réponse.

Par ailleurs une anomalie en C11, C12 et C13 puisque la date est erronée : 00/01/1900 ( a priori conversion en date d'une cellule vide)

A+
 

Discussions similaires

Réponses
2
Affichages
221

Statistiques des forums

Discussions
312 348
Messages
2 087 510
Membres
103 570
dernier inscrit
patrickb83p