XL 2016 MFC sur plusieurs critères

L

Lorenzini

XLDnaute Occasionnel
Bonjour,

N'ayant plus de solutions (vu mon niveau limité en vba car j'imagine qu'il va falloir passer par là...), je me tourne vers vous car je patauge.
Dans le petit tableau que j'ai joins à ce message, je souhaiterais que le statut d'une ligne prévale sur le(s) statut(s) d'une/des autre(s) ligne(s) ; je donne qq exemples pour illustrer :

1721845828931.png


En changeant le statut (j'ai fais une MFC) d' "en cours" à "prêt" de la ligne 24 p.ex., je cherche à ce que

- toutes les lignes précédentes du tableau (jusqu'à celles qui avaient le statut "prêt" ; c'est la limite, s'il y'en a) ayant le même n° de chariot (colonne G), prennent le même statut.

Concrètement, si clique dans la cellule K24 pour passer d'"en cours" à "prêt", je cherche à ce que les lignes encadrées en rouge (20 et 12 car n° de chariot identique à la ligne 24) se changent à leur tour en "prêt" (et prennent la même mise en forme, couleur).

Autre exemple (qui ajoute encore en difficultés, comme si ce n'était pas assez compliqué comme çà !) :

1721847182375.png


En changeant le statut "en cours" de la ligne 23, la ligne 18 (qui a le même n° de chariot) se changerait également.

Les difficultés supplémentaires sont que :

1) ici, pour cet exemple, la ligne 10 (qui a aussi un n° de chariot commun) NE DOIT PAS changer car elle a déjà le statut "prêt" !

2) plusieurs de mes collègues seront censés travailler avec ce tableau ; quid si un utilisateur va trop vite et réalise trop tard qu'il a changé le statut d'"en cours" à "prêt" ?
Comment refaire le chemin inverse SANS CHANGER les lignes précédentes qui avaient le même n° de chariot MAIS QUI AVAIT DEJA le statut "prêt" ? (comme la ligne 10)
Il ne faudrait pas qu'en repassant de "prêt" à "en cours", la ligne 10 se change elle aussi de "prêt" à "en cours" !...

Pfff, je ne sais pas si je suis assez clair mais qui que vous soyez, vous aurez déjà été assez courageux d'avoir lu tout ce que j'ai écrit jusqu'ici ! 😁

Je vous avoue très honnêtement que çà fait quelques jours que je creuse... je sors tout juste de m'être cassé la tête d'avoir résolu d'autres choses comme le fait qu'Excel ne me recalcule pas l'heure automatiquement... mais là, je ne sais plus !

Si vous pouviez m'aider, j'apprécierai grandement ! :)
 

Pièces jointes

  • JOKIMIO TEST 3.xlsm
    44.8 KB · Affichages: 6
Solution
L
crocrocro à dit:
pour les les ######## Il faut simplement élargir la colonne
en pj, nouveau fichier avec le message de confirmation plus petit correctif
VB: 
Sub MajStatut(pTarget As Range)
Dim Ligne As Long, nbLigRetour As Long
Dim NouveauStatut
Dim MemoDateMaj As Date
Dim Reponse As Integer
Dim Message As String
Dim LigneEnCours As Boolean

    Application.EnableEvents = False
    MemoDateMaj = Now
    NouveauStatut = pTarget.Value
    Ligne = pTarget.Row - ActiveSheet.Range("Tableau3").Row + 1
    If NouveauStatut = "en cours" Then
        ' on compte le nombre de lignes éventuellemnt concernées pour un retour arrière pour éventuellemnt afficher un message
        nbLigRetour = 0
        For i = 1 To Ligne - 1
            ' on compte les lignes...
Cliquez pour agrandir...
Trier par date Trier par votes
C

crocrocro

XLDnaute Occasionnel
pour les les ######## Il faut simplement élargir la colonne
en pj, nouveau fichier avec le message de confirmation plus petit correctif
VB: 
Sub MajStatut(pTarget As Range)
Dim Ligne As Long, nbLigRetour As Long
Dim NouveauStatut
Dim MemoDateMaj As Date
Dim Reponse As Integer
Dim Message As String
Dim LigneEnCours As Boolean

    Application.EnableEvents = False
    MemoDateMaj = Now
    NouveauStatut = pTarget.Value
    Ligne = pTarget.Row - ActiveSheet.Range("Tableau3").Row + 1
    If NouveauStatut = "en cours" Then
        ' on compte le nombre de lignes éventuellemnt concernées pour un retour arrière pour éventuellemnt afficher un message
        nbLigRetour = 0
        For i = 1 To Ligne - 1
            ' on compte les lignes précédentes qui ont statut "prêt" même n° de chariot et même date maj statut
            If ActiveSheet.Range("Tableau3[Statut]").Cells(i, 1) = "prêt" And _
                ActiveSheet.Range("Tableau3[N° chariot]").Cells(i, 1) = ActiveSheet.Range("Tableau3[N° chariot]").Cells(Ligne, 1) And _
                ActiveSheet.Range("Tableau3[Date Statut]").Cells(i, 1) = ActiveSheet.Range("Tableau3[Date Statut]").Cells(Ligne, 1) And _
                ActiveSheet.Range("Tableau3[Date Statut]").Cells(i, 1) <> "" Then
                nbLigRetour = nbLigRetour + 1
            End If
        Next i
        If nbLigRetour > 0 Then
            Message = "Il existe " & nbLigRetour + 1 & " lignes avec le n° de chariot " & ActiveSheet.Range("Tableau3[N° chariot]").Cells(Ligne, 1) & vbCrLf _
                    & "Oui pour un Retour au Statut En Cours pour toutes ces lignes" & vbCrLf _
                    & "Non pour un Retour au Statut En Cours uniquement pour la ligne en Cours" & vbCrLf _
                    & "Annuler pour un Retour au Statut En Cours uniquement pour la ligne en Cours"
                    
            Reponse = MsgBox(Message, vbYesNoCancel, "Retour au Statut En Cours")
            Select Case Reponse
                Case vbYes
                    LigneEnCours = False
                Case vbNo
                    LigneEnCours = True
                Case vbCancel
                    ActiveSheet.Range("Tableau3[Statut]").Cells(Ligne, 1) = "prêt"
                    GoTo Fin
            End Select
        End If
    End If
    For i = 1 To Ligne - 1
        ' balayage des lignes précédentes
        'Debug.Print "Statut : " & ActiveSheet.Range("Tableau3[Statut]").Cells(i, 1)
        'Debug.Print "N° chariot : " & ActiveSheet.Range("Tableau3[N° chariot]").Cells(i, 1)
        'Debug.Print "Service : " & ActiveSheet.Range("Tableau3[Service]").Cells(i, 1)
        
        Select Case True
            Case NouveauStatut = "prêt"
            ' on positionne à "prêt" les lignes précédentes qui ont le même chariot
                If ActiveSheet.Range("Tableau3[Statut]").Cells(i, 1) <> NouveauStatut And _
                    ActiveSheet.Range("Tableau3[N° chariot]").Cells(i, 1) = ActiveSheet.Range("Tableau3[N° chariot]").Cells(Ligne, 1) Then
                    ActiveSheet.Range("Tableau3[Statut]").Cells(i, 1) = NouveauStatut
                    ActiveSheet.Range("Tableau3[Date Statut]").Cells(i, 1) = MemoDateMaj
                End If
            Case NouveauStatut = "en cours"
            ' on positionne à "en cours" les lignes précédentes qui ont statut "prêt" m^me n° e chariot et même date maj statut
                If ActiveSheet.Range("Tableau3[Statut]").Cells(i, 1) = "prêt" And _
                    ActiveSheet.Range("Tableau3[N° chariot]").Cells(i, 1) = ActiveSheet.Range("Tableau3[N° chariot]").Cells(Ligne, 1) And _
                    ActiveSheet.Range("Tableau3[Date Statut]").Cells(i, 1) = ActiveSheet.Range("Tableau3[Date Statut]").Cells(Ligne, 1) And _
                    ActiveSheet.Range("Tableau3[Date Statut]").Cells(i, 1) <> "" And _
                    Not LigneEnCours Then
                        ActiveSheet.Range("Tableau3[Statut]").Cells(i, 1) = NouveauStatut
                        ActiveSheet.Range("Tableau3[Date Statut]").Cells(i, 1) = MemoDateMaj
                End If
        End Select
    Next i

    ActiveSheet.Range("Tableau3[Date Statut]").Cells(Ligne, 1) = MemoDateMaj
Fin:
    Application.EnableEvents = True
End Sub
 

Pièces jointes

  • JOKIMIO TEST 3 crocrocro.xlsm
    86.6 KB · Affichages: 1
Vote positif 0 Vote négatif
L

Lorenzini

XLDnaute Occasionnel
crocrocro à dit:
pour les les ######## Il faut simplement élargir la colonne
en pj, nouveau fichier avec le message de confirmation plus petit correctif
VB: 
Sub MajStatut(pTarget As Range)
Dim Ligne As Long, nbLigRetour As Long
Dim NouveauStatut
Dim MemoDateMaj As Date
Dim Reponse As Integer
Dim Message As String
Dim LigneEnCours As Boolean

    Application.EnableEvents = False
    MemoDateMaj = Now
    NouveauStatut = pTarget.Value
    Ligne = pTarget.Row - ActiveSheet.Range("Tableau3").Row + 1
    If NouveauStatut = "en cours" Then
        ' on compte le nombre de lignes éventuellemnt concernées pour un retour arrière pour éventuellemnt afficher un message
        nbLigRetour = 0
        For i = 1 To Ligne - 1
            ' on compte les lignes précédentes qui ont statut "prêt" même n° de chariot et même date maj statut
            If ActiveSheet.Range("Tableau3[Statut]").Cells(i, 1) = "prêt" And _
                ActiveSheet.Range("Tableau3[N° chariot]").Cells(i, 1) = ActiveSheet.Range("Tableau3[N° chariot]").Cells(Ligne, 1) And _
                ActiveSheet.Range("Tableau3[Date Statut]").Cells(i, 1) = ActiveSheet.Range("Tableau3[Date Statut]").Cells(Ligne, 1) And _
                ActiveSheet.Range("Tableau3[Date Statut]").Cells(i, 1) <> "" Then
                nbLigRetour = nbLigRetour + 1
            End If
        Next i
        If nbLigRetour > 0 Then
            Message = "Il existe " & nbLigRetour + 1 & " lignes avec le n° de chariot " & ActiveSheet.Range("Tableau3[N° chariot]").Cells(Ligne, 1) & vbCrLf _
                    & "Oui pour un Retour au Statut En Cours pour toutes ces lignes" & vbCrLf _
                    & "Non pour un Retour au Statut En Cours uniquement pour la ligne en Cours" & vbCrLf _
                    & "Annuler pour un Retour au Statut En Cours uniquement pour la ligne en Cours"
                   
            Reponse = MsgBox(Message, vbYesNoCancel, "Retour au Statut En Cours")
            Select Case Reponse
                Case vbYes
                    LigneEnCours = False
                Case vbNo
                    LigneEnCours = True
                Case vbCancel
                    ActiveSheet.Range("Tableau3[Statut]").Cells(Ligne, 1) = "prêt"
                    GoTo Fin
            End Select
        End If
    End If
    For i = 1 To Ligne - 1
        ' balayage des lignes précédentes
        'Debug.Print "Statut : " & ActiveSheet.Range("Tableau3[Statut]").Cells(i, 1)
        'Debug.Print "N° chariot : " & ActiveSheet.Range("Tableau3[N° chariot]").Cells(i, 1)
        'Debug.Print "Service : " & ActiveSheet.Range("Tableau3[Service]").Cells(i, 1)
       
        Select Case True
            Case NouveauStatut = "prêt"
            ' on positionne à "prêt" les lignes précédentes qui ont le même chariot
                If ActiveSheet.Range("Tableau3[Statut]").Cells(i, 1) <> NouveauStatut And _
                    ActiveSheet.Range("Tableau3[N° chariot]").Cells(i, 1) = ActiveSheet.Range("Tableau3[N° chariot]").Cells(Ligne, 1) Then
                    ActiveSheet.Range("Tableau3[Statut]").Cells(i, 1) = NouveauStatut
                    ActiveSheet.Range("Tableau3[Date Statut]").Cells(i, 1) = MemoDateMaj
                End If
            Case NouveauStatut = "en cours"
            ' on positionne à "en cours" les lignes précédentes qui ont statut "prêt" m^me n° e chariot et même date maj statut
                If ActiveSheet.Range("Tableau3[Statut]").Cells(i, 1) = "prêt" And _
                    ActiveSheet.Range("Tableau3[N° chariot]").Cells(i, 1) = ActiveSheet.Range("Tableau3[N° chariot]").Cells(Ligne, 1) And _
                    ActiveSheet.Range("Tableau3[Date Statut]").Cells(i, 1) = ActiveSheet.Range("Tableau3[Date Statut]").Cells(Ligne, 1) And _
                    ActiveSheet.Range("Tableau3[Date Statut]").Cells(i, 1) <> "" And _
                    Not LigneEnCours Then
                        ActiveSheet.Range("Tableau3[Statut]").Cells(i, 1) = NouveauStatut
                        ActiveSheet.Range("Tableau3[Date Statut]").Cells(i, 1) = MemoDateMaj
                End If
        End Select
    Next i

    ActiveSheet.Range("Tableau3[Date Statut]").Cells(Ligne, 1) = MemoDateMaj
Fin:
    Application.EnableEvents = True
End Sub
Cliquez pour agrandir...

Beau travail !

Cette dernière solution est le top du top et je vais tâcher de me pencher dessus pour la maîtriser.
J'avoue que j'utilise VBA depuis de nombreuses années et que je ne suis pas du tout familier de la commande debug.print p.ex.
Votre solution est l'idéale !
Merci pour votre sollicitude ; j'aurai été incapable de trouver la solution seul.

Merci ! 😁 👍
 
Vote positif 0 Vote négatif
Solution
L

Lorenzini

XLDnaute Occasionnel
crocrocro à dit:
Merci ... pour vos remerciements.
Il y a toujours des choses à apprendre sur Excel.
Pour le débutant bien sûr comme pour celui qui pratique depuis longtemps comme moi.
Bonne continuation.
Cliquez pour agrandir...
Bonjour crocrocro,


Je reviens vers vous qui m'avez si bien aidé ... 👍 😁

Je ne sais pas si je dois créer un nouveau contenu ? pour le problème auquel je fais face, mais ll y'a une chose qui est sûre, c'est que celà fait qq jours que je m'arrache les cheveux pour trouver une solution ... sans résultats 😩😓

Je commence par revenir vers vous car vous vous êtes penché sur mon tableau avec deux propositions de solutions (qui marchent du tonnerre en prime)

Si besoin, je transférerai mon message au reste de la communauté...

Pour faire court : A l'ouverture du fichier, après avoir cliqué sur "lancer le programme", on a le choix entre 2 boutons :

1 ---> Economat
l'autre --> Aides-logistiques

L'idée est de restreindre l'accès au tableau (par ''ScrollArea'') selon le choix effectué.

En cliquant sur ''Aides-logistiques'', on a accès uniquement aux colonnes N à P (cette dernière se remplissant uniquement si N ET O remplis)... jusque-là, tout va bien.
En cliquant sur ''Economat'', on a accès uniquement aux colonnes B à M.

En haut à gauche de la feuille, j'ai ajouté un bouton '+' qui permet d'ajouter une ligne d'encodage au tableau.
En cliquant desssus, ouverture d'une msgbox pour choisir entre 2 options :
soit encoder = 'OUI' --> nouvelle ligne d'encodage... tout va bien
soit encoder = 'NON' --> voilà le problème QUI ME FAIT DEVENIR DINGUE DEPUIS 3 JOURS !!! 😱😰😵‍💫😵

Pourquoi la cellule se remplit par une date lorsqu'on choisit 'non' !?!

probleme 1.jpg
probleme 1-1.jpg


Si vous pouviez m'aider, ce serait super ; je suis prêt à partager avec d'autres s'il faut, mais mes connaissances rudimentaires (je 'bricole' + que je ne programme véritablement) ne me permettent pas de voir d'où vient le problème ni comment le solutionner...

MERCI d'avance pour toute l'aide que vous pourriez m'apporter :)
 

Pièces jointes

  • JOKIMIO HELP.xlsm
    353.8 KB · Affichages: 0
Vote positif 0 Vote négatif
L

Lorenzini

XLDnaute Occasionnel
TooFatBoy à dit:
Coucou on est là... 👋
Cliquez pour agrandir...
Bonjour TooFatBoy 😃

Je suis désespéré car je ne trouve pas de solution à mon problème...
hum hum... j'ai vraiment encore du boulot sur la planche avec VBA :p:p

Je présume que vous avez vu le message que j'ai adressé à crocrocro ?

Juste au cas où, le voici :


Pour faire court : A l'ouverture du fichier, après avoir cliqué sur "lancer le programme", on a le choix entre 2 boutons :

1 ---> Economat
l'autre --> Aides-logistiques

L'idée est de restreindre l'accès au tableau (par ''ScrollArea'') selon le choix effectué.

En cliquant sur ''Aides-logistiques'', on a accès uniquement aux colonnes N à P (cette dernière se remplissant uniquement si N ET O remplis)... jusque-là, tout va bien.

En cliquant sur ''Economat'', on a accès uniquement aux colonnes B à M.

En haut à gauche de la feuille, j'ai ajouté un bouton '+' qui permet d'ajouter une ligne d'encodage au tableau.

En cliquant desssus, ouverture d'une msgbox pour choisir entre 2 options :

soit encoder = 'OUI' --> nouvelle ligne d'encodage... tout va bien
soit encoder = 'NON' --> voilà le problème QUI ME FAIT DEVENIR DINGUE DEPUIS 3 JOURS !!!

Pourquoi la cellule se remplit par une date lorsqu'on choisit 'non' !?!
 

Pièces jointes

  • probleme 1.jpg
    probleme 1.jpg
    358.4 KB · Affichages: 2
  • probleme 1-1.jpg
    probleme 1-1.jpg
    486.4 KB · Affichages: 5
  • JOKIMIO HELP.xlsm
    353.8 KB · Affichages: 2
Vote positif 0 Vote négatif
L

Lorenzini

XLDnaute Occasionnel
Lorenzini à dit:
coooooool :)
Cliquez pour agrandir...
...j'ai encore une curiosité que je ne comprends pas !? ...
pourquoi lorsqu'on clique sur le '+' pour ajouter un nouvel encodage, la nouvelle ligne ne prend pas la mise en forme de celle du dessus ?
En gros, pourquoi le tableau ne continue pas une ligne sur 2 en bleu comme les lignes précédentes !?
Quelle est cette curiosité ? Comment y remédier ?

Voir image ci-dessus (ligne 20, 21, ...) ne sont pas comme celles d'avant ; une fois bleue, une fois blanche, ...

Celà peut paraitre une bêtise pour ceux qui sont maîtres d'Excel mais j'avoue que je ne sais pas comment faire en sorte que ces nouvelles lignes soient comme les précédentes !?

1722882281692.png
 
Vote positif 0 Vote négatif
L

Lorenzini

XLDnaute Occasionnel
TooFatBoy à dit:
En fait je crois que ça vient du fait que ta feuille est protégée, donc on ne peut pas ajouter de lignes au TS.
Cliquez pour agrandir...
j'y ai pensé aussi mais je viens de vérifier avec une version antérieure (à chaque nouvelle étape, je fais des copies), et là, çà fonctionne ; or il y'a des protections...
C'est vraiment un mystère...

Je note que lorsque je retire ceci :

VB: 
If Not Intersect(Range("P7:P100000"), Target) Is Nothing And ActiveCell.Offset(0, -2).Value <> "" And ActiveCell.Offset(0, -1).Value <> "" Then

        'Dim e As Integer

        '    e = ActiveCell.Address
            
        'Range("L1").Value = e

        Range("K1").FormulaR1C1 = "=NOW()"
        Range("K1").NumberFormat = "dd/mm/yyyy  hh""h""mm"
        'Range(Range("L1").Value).Select
        ActiveCell.Value = Range("K1").Text
        Range("K1").ClearContents
        ActiveCell.Offset(1, -2).Select
        
        Dim e As Integer
        Dim f, g As String

            e = ActiveCell.Row
            f = "N" & e
            g = "P100000"
            H = f & ":" & g

        Range("P1").Value = H
        
        ActiveSheet.ScrollArea = H
        
        Range("P1").ClearContents
        
End If

je n'ai plus la date qui s'affiche en colonne 'B' lorsque je choisis non à la boîte de dialogue de confirmation d'ajout d'une ligne...
 
Vote positif 0 Vote négatif
L

Lorenzini

XLDnaute Occasionnel
Lorenzini à dit:
j'y ai pensé aussi mais je viens de vérifier avec une version antérieure (à chaque nouvelle étape, je fais des copies), et là, çà fonctionne ; or il y'a des protections...
C'est vraiment un mystère...

Je note que lorsque je retire ceci :

VB: 
If Not Intersect(Range("P7:P100000"), Target) Is Nothing And ActiveCell.Offset(0, -2).Value <> "" And ActiveCell.Offset(0, -1).Value <> "" Then

        'Dim e As Integer

        '    e = ActiveCell.Address
           
        'Range("L1").Value = e

        Range("K1").FormulaR1C1 = "=NOW()"
        Range("K1").NumberFormat = "dd/mm/yyyy  hh""h""mm"
        'Range(Range("L1").Value).Select
        ActiveCell.Value = Range("K1").Text
        Range("K1").ClearContents
        ActiveCell.Offset(1, -2).Select
       
        Dim e As Integer
        Dim f, g As String

            e = ActiveCell.Row
            f = "N" & e
            g = "P100000"
            H = f & ":" & g

        Range("P1").Value = H
       
        ActiveSheet.ScrollArea = H
       
        Range("P1").ClearContents
       
End If

je n'ai plus la date qui s'affiche en colonne 'B' lorsque je choisis non à la boîte de dialogue de confirmation d'ajout d'une ligne...
Cliquez pour agrandir...
par contre, j'ai les accès aux colonnes N, O et P et çà, ce n'est pas ce que je souhaite...
Je voulais limiter l'accès (depuis le bouton ECONOMAT) aux colonnes B à M...
 
Vote positif 0 Vote négatif

Discussions similaires

A
  • Question
XL 2016 Calculer un pourcentage selon les choix dans des listes déroulantes
Réponses
3
Affichages
410
amgue
A
C
  • Question
XL pour MAC Conditions excel
Réponses
9
Affichages
803
catwoman69
C
A
  • Question
Microsoft 365 Création d'un planning d'entretiens
Réponses
3
Affichages
155
TooFatBoy
TooFatBoy
S
  • Résolu(e)
Microsoft 365 Copier automatiquement sur une ligne sur une autre feuille si la date est supérieur à une date définie
2
Réponses
17
Affichages
875
S.J
S
C
  • Question
Autres XL 2003 Adaptation de la gestion de prêt
Réponses
6
Affichages
257
cheg
C
piga25
  • Résolu(e)
XL 2016 Erreur dans code VBA
4 5 6
Réponses
77
Affichages
2 K
patricktoulon
patricktoulon
R
  • Question
Microsoft 365 Importation URL d’images en masse
Réponses
0
Affichages
152
Roro1313
R
S
  • Résolu(e)
Microsoft 365 Reporter le contenu d'une plage dans une cellule selon un ordre précis
Réponses
4
Affichages
130
sebastien176
S
E
  • Résolu(e)
Microsoft 365 recherchex dans plusieurs colonnes non contigues
Réponses
4
Affichages
482
eric72
E
Chaton77
  • Résolu(e)
Microsoft 365 En VBA : Extraire le mois d'une date d'un tableau
Réponses
7
Affichages
237
Chaton77
Chaton77

Membres actuellement en ligne

17 membres et 314 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 422
Messages
2 109 447
Membres
110 482
dernier inscrit
ilyxxxh