Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2021 Fixer une valeur dépend d'autre "Excel"

Anr1

XLDnaute Occasionnel
Supporter XLD
Bonjour à tous,

Je suis à la recherche d'une méthode (Formule) pour définir l'attribut "salarié" si une occurrence de cette valeur est trouvée pour un numéro de section donné.

Par exemple : si, sur cinq lignes de la section "10", une seule valeur contient le mot "salarié" dans la colonne "CSP", alors le mot "Salarié" sera placé pour les 4 autres lignes.

Vous trouverez en pièce jointe un exemple illustrant la solution souhaitée.

Je vous remercie par avance

Cordialement.
 

Pièces jointes

  • test.xlsx
    9.2 KB · Affichages: 3
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour Anr1,

Voyez le fichier joint et cette macro dans le code de la feuille :
VB:
Option Compare Text 'la casse est ignorée

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x$, d As Object, tablo, i&
x = "Salarié"
Set d = CreateObject("Scripting.Dictionary")
With [A1].CurrentRegion.Resize(, 2)
    tablo = .Value 'matrice, plus rapide
    For i = 1 To UBound(tablo)
        If tablo(i, 1) = x Then d(tablo(i, 2)) = ""
    Next i
    For i = 1 To UBound(tablo)
        If d.exists(tablo(i, 2)) Then tablo(i, 1) = x
    Next i
    '---restitution---
    Application.EnableEvents = False
    .Value = tablo
    Application.EnableEvents = True
End With
End Sub
Elle se déclenche quand on modifie ou valide une cellule quelconque.

A+
 

Pièces jointes

  • test.xlsm
    14.9 KB · Affichages: 1

Anr1

XLDnaute Occasionnel
Supporter XLD
Merci beaucoup @job75 , c'est génial !
J'ai essayé de l'appliquer dans ma base de travail, mais ça ne fonctionne pas. La variable à changer dans ma base se trouve dans la colonne C au lieu de la colonne A, et la variable de référence se trouve dans la colonne E au lieu de la colonne B. Voici le code :

Code:
Option Explicit
Option Compare Text 'la casse est ignorée

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x$, d As Object, tablo, i&
x = "SALARIE/CONJOINT/ENFANT"
Set d = CreateObject("Scripting.Dictionary")
With [C1].CurrentRegion.Resize(, 3)
    tablo = .Value 'matrice, plus rapide
    For i = 1 To UBound(tablo)
        If tablo(i, 3) = x Then d(tablo(i, 4)) = ""
    Next i
    For i = 1 To UBound(tablo)
        If d.exists(tablo(i, 4)) Then tablo(i, 3) = x
    Next i
    '---restitution---
    Application.EnableEvents = False
    .Value = tablo
    Application.EnableEvents = True
End With
End Sub

Merci d'avance.
 

Pièces jointes

  • test (1).xlsm
    92.4 KB · Affichages: 1

job75

XLDnaute Barbatruc
D'où l'intérêt de présenter au départ un fichier représentatif.

La macro affectée au bouton dans Module1 :
VB:
Option Compare Text 'la casse est ignorée

Sub a()
Dim x$, d As Object, tablo, i&
x = "Salarié"
Set d = CreateObject("Scripting.Dictionary")
With [C1].CurrentRegion.Resize(, 3)
    tablo = .Value 'matrice, plus rapide
    For i = 1 To UBound(tablo)
        If tablo(i, 1) = x Then d(tablo(i, 3)) = ""
    Next i
    For i = 1 To UBound(tablo)
        If d.exists(tablo(i, 3)) Then tablo(i, 1) = x
    Next i
    '---restitution---
    .Value = tablo
End With
End Sub
 

Pièces jointes

  • test (1).xlsm
    17.7 KB · Affichages: 2

Anr1

XLDnaute Occasionnel
Supporter XLD
Bonjour @job75 ,

Merci beaucoup ! La macro fonctionne très bien.

Cependant, lorsque je l'applique à mon fichier, je reçois un message d'erreur "L'indice n'appartient pas à la sélection".
VB:
Option Explicit
Option Compare Text 'la casse est ignorée

Sub a()
Dim wks As Worksheet
Set wks = Sheets("xxx")
Dim x$, d As Object, tablo, i&
x = "Salarié"
Set d = CreateObject("Scripting.Dictionary")
With [C1].CurrentRegion.Resize(, 3)
    tablo = .Value 'matrice, plus rapide
    For i = 1 To UBound(tablo)
        If tablo(i, 3) = x Then d(tablo(i, 5)) = ""
    Next i
    For i = 1 To UBound(tablo)
        If d.exists(tablo(i, 5)) Then tablo(i, 3) = x
    Next i
    '---restitution---
    .Value = tablo
End With
End Sub

Pouvez-vous me dire où se situe mon erreur s'il vous plait ?

NB : Je suis effectivement désolé de ne pas avoir fourni un fichier représentatif dès le départ

D'avance merci!
 

Pièces jointes

  • test (1) (1).xlsm
    20.3 KB · Affichages: 2

Anr1

XLDnaute Occasionnel
Supporter XLD
Bonjour Anr1,

Sans fichier représentatif du bug je ne vois pas.

Vérifiez qu'il n'y a pas une autre macro qui crée le bug.

A+
Rebonjour @job75,

Effectivement, vous avez raison, sans un fichier représentatif du bug, c'est compliqué !J'ai essayé de créer un nouveau fichier similaire à mes besoins (à l'exception du volume des données), qui présente également un bug.

Merci bcp pour votre aide.
 

Pièces jointes

  • test test.xlsm
    18.9 KB · Affichages: 1

job75

XLDnaute Barbatruc
Bah vous passez votre temps à bricoler les fichiers !!!

Ce fichier n'est pas du tout le même que celui du post #3, utilisez :
VB:
Option Compare Text 'la casse est ignorée

Sub a()
Dim wks As Worksheet
Set wks = Sheets("test")
Dim x$, d As Object, tablo, i&
x = "Salarié"
Set d = CreateObject("Scripting.Dictionary")
With [A1].CurrentRegion.Resize(, 5)
    tablo = .Value 'matrice, plus rapide
   For i = 1 To UBound(tablo)
        If tablo(i, 3) = x Then d(tablo(i, 5)) = ""
   Next i
    For i = 1 To UBound(tablo)
        If d.exists(tablo(i, 5)) Then tablo(i, 3) = x
    Next i
    '---restitution---
    .Value = tablo
End With
End Sub
 

Pièces jointes

  • test test.xlsm
    17.9 KB · Affichages: 1

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…