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"

A

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:
Trier par date Trier par votes

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
Vote positif 0 Vote négatif
A

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
Vote positif 0 Vote négatif

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
Vote positif 0 Vote négatif
A

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
Vote positif 0 Vote négatif
A

Anr1

XLDnaute Occasionnel
Supporter XLD
job75 à dit:
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+
Cliquez pour agrandir...
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
Vote positif 0 Vote négatif

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
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

B
  • Question
XL 2016 VBA et valeur cible sur cellules différentes
Réponses
3
Affichages
191
Lolote83
L
A
  • Résolu(e)
XL 2019 Créer une base de données à partir de plusieurs fichiers excel source
Réponses
7
Affichages
1 K
adrien786
A
  • Question
Microsoft 365 Macro pour renvoyer la valeur par rapport à un intervalle
Réponses
6
Affichages
377
sylvanu
L
  • Résolu(e)
Microsoft 365 VBA - Attribuer mise en forme en fonction de valeur cellule d'une liste
Réponses
14
Affichages
657
Laliepomm
L
N
  • Question
Microsoft 365 Fonction si avec une valeur différente de 1
Réponses
3
Affichages
356
NILS19
N
  • Question
XL 2016 Générer une liste excel suivant des informations dans un fichier
2
Réponses
15
Affichages
717
chris
P
  • Question
XL 2016 Optimisation du Nettoyage de Données : Remplacement Générique
Réponses
4
Affichages
453
sousou
N
  • Résolu(e)
XL 2021 Recherche une valeur avec plusieurs conditions
Réponses
10
Affichages
530
Lolote83
L
Y
  • Question
XL 2019 Affichage de phrase sous conditions
Réponses
6
Affichages
527
Yassin9
Y
E
  • Question
XL 2019 Identification des doublons sur la base des attributs de produits
Réponses
3
Affichages
640
ExcelBeginner
E
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…