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

Statistiques des forums

Discussions
315 144
Messages
2 116 721
Membres
112 846
dernier inscrit
Filou714