Bonjour tout le monde,
Je me retourne vers vous parce que je sèche complètement depuis deux jours maintenant.
Dans mon fichier Excel, je veux effectuer des modifications en cascade. Je m'explique, si une personne modifie le nom et/ou civilité et/ou le prénom dans la feuille "Personnes", je dois modifier toutes les entrées correspondantes à cette personnes dans les autres onglets. Je ne veux pas faire une recherche par une input box, mais à partir du moment ou la personne modifie le nom ou le prénom et la civilité.
j'ai trouvé un code permettant de faire une recherche sur plusieurs feuilles et je l'ai adapté pour le remplacement. Le problème qui se pose est d'une part que j'ai une boucle infinie... cad il commence par faire les modifications puis il boucle sur les autres noms qui eux n'ont pas été "modifiés". et maintenant, j'ai un autre problème avec Application.CountIf(ws.UsedRange, "=" & chaine).
Je vous joins mon fichier pour mieux comprendre et donc pour mieux m'aider.
Il faut savoir que je concatène les champs civilité, nom, particule, prénom et que la valeur qui remplace est la concaténation (colonne masquée Z de la feuille "Personnes")
Je désespère de trouver une solution, et je remercie d'avance toutes les personnes qui s'intéresseront à mon problème.
Je me retourne vers vous parce que je sèche complètement depuis deux jours maintenant.
Dans mon fichier Excel, je veux effectuer des modifications en cascade. Je m'explique, si une personne modifie le nom et/ou civilité et/ou le prénom dans la feuille "Personnes", je dois modifier toutes les entrées correspondantes à cette personnes dans les autres onglets. Je ne veux pas faire une recherche par une input box, mais à partir du moment ou la personne modifie le nom ou le prénom et la civilité.
j'ai trouvé un code permettant de faire une recherche sur plusieurs feuilles et je l'ai adapté pour le remplacement. Le problème qui se pose est d'une part que j'ai une boucle infinie... cad il commence par faire les modifications puis il boucle sur les autres noms qui eux n'ont pas été "modifiés". et maintenant, j'ai un autre problème avec Application.CountIf(ws.UsedRange, "=" & chaine).
Je vous joins mon fichier pour mieux comprendre et donc pour mieux m'aider.
Il faut savoir que je concatène les champs civilité, nom, particule, prénom et que la valeur qui remplace est la concaténation (colonne masquée Z de la feuille "Personnes")
Je désespère de trouver une solution, et je remercie d'avance toutes les personnes qui s'intéresseront à mon problème.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Object
Dim foundCell As Variant
Dim chaine, returnValue, rempl As String
Dim total, cpt As Long
chaine = Cells(Target.Row, Range("Personne_Concat").Column).Value
rempl = Cells(Target.Row, "Z").Value
If Len(chaine) = 0 Then
Exit Sub
Else
For Each ws In Worksheets(Array("Personnes", "Structures-Personnes"))
total = total + Application.CountIf(ws.UsedRange, "=" & chaine)
Next ws
End If
If total = 0 Then
MsgBox "Il n'existe pas d'autre entrée correspondant à cette personne", vbOKOnly, "Message"
Exit Sub
Else
cpt = 0
For Each ws In Worksheets(Array("Personnes", "Structures-Personnes"))
With ws
.Activate
Set foundCell = .Cells.Find(What:=chaine, LookIn:=xlValues, LookAt:=xlPart)
If Not foundCell Is Nothing Then
Do
cpt = cpt + 1
foundCell.Activate
Select Case total
Case Is = 1
MsgBox "Il existe une seule entrée correspondant à " & chaine, vbOKOnly, "Message"
foundCell.Replace What:=chaine, Replacement:=rempl, LookAt:=xlPart, MatchCase:=True
MsgBox "Cette entrée a été remplacée par : " & rempl, vbOKOnly, "Message"
Exit Sub
Case Is = cpt
MsgBox "Dernière entrée correspondant à " & chaine, vbOKOnly, "Message"
foundCell.Replace What:=chaine, Replacement:=rempl, LookAt:=xlPart, MatchCase:=True
MsgBox "Fin des modifications pour : " & chaine, vbOKOnly, "Message"
Sheets("Personnes").Activate
Range("C3").Select
Exit Sub
Case Else
MsgBox "Entrée n° " & cpt & " correspondant à " & chaine, vbOKOnly, "Message"
foundCell.Replace What:=chaine, Replacement:=rempl, LookAt:=xlPart, MatchCase:=True
returnValue = MsgBox("Cette entrée a été remplacée par : " & rempl & vbLf & "Voulez-vous continuer les modifications ?", vbYesNo, "Message")
If returnValue = vbNo Then
Exit Sub
Else
Set foundCell = .Cells.FindNext(After:=foundCell)
End If
End Select
Loop Until foundCell Is Nothing
Else
Exit Sub
End If
End With
Next ws
End If
End Sub
Pièces jointes
Dernière édition: