base

[philmar]

Bonjour!
grâce à ce super forum l'établissement médico socialque je gère , (et qui n'a pas beaucoup de moyens), dispose d'un "tableau de bord " sur le modèle ci-joint, soit une base (premier onglet) base de donnée avec les 100 patients, et cela nous sert à faire des calculs, des impressions grâce à des liaisons sur sur les onglets suivants...
je voudrais savoir s'il est possible que si on efface un nom dans la base, que cela efface des cellules sur une autre page, cad si on efface un nom dans la base parce qu'on change de patient dans la chambre, que cela efface automatiquement (donnée1 donnee2 donnee3 dans onglet regime) dans la ligne où il y avait le nom lié, afin d'éviter que quand on met un autre patient dans la base il hérite par erreur des infos qui ne sont pas les siennes et qui n'auraient pas été effacées dans la page liée...Merci pour votre aide
Bien cordialement
Philippe

 

[freefer]

Re : base

Bonsoir,

C'est possible, mais il faudrait ajouter un formulaire avec boite de dialogue en VBA (Visual Basic pour Applications) pour entrer et effacer les données liées.

Cordialement,

Freefer

 

[job75]

Re : base

Bonsoir Philmar, Freefer,

Quand on efface le nom en feuille1, la cellule liée en feuille 2 prend la valeur 0.

Quand on supprime la ligne en feuille1, la cellule liée prend la valeur d'erreur #REF!

Avec un filtre automatique en feuille 2, filtrant sur la colonne A, on peut sélectionner la ligne concernée et l'effacer ou la supprimer.

Je vais voir comment automatiser cela en VBA, un peu de patience.

A+

 

[job75]

Re : base

Re bonsoir,

J'ai été un peu long parce que l'idée du filtre automatique n'était finalement pas la bonne.

Voici une macro qui fonctionne avec la méthode Find, elle est à placer dans le code de la feuille "regime" (clic droit sur l'onglet et Visualiser le code) :

Private Sub Worksheet_Calculate()
Dim C1, C2 As Range
On Error Resume Next
Set C1 = Range("A2:A65536").Find(0, LookIn:=xlValues)
Set C2 = Range("A2:A65536").Find("#REF!")
Intersect(C1.EntireRow,Range("D:F")).ClearContents
C2.EntireRow.Delete
End Sub

La macro se déclanche chaque fois qu'une formule est recalculée dans la feuille.

A+

 

[philmar]

Re : base

Bonjour,
et merci pour vos réponses!
par contre je crains d'avoir mal formulé mon problème, en fait si on efface ZETOFRAIS dans base, cela va mettre dans la feuille REGIME le lien à 0 dans A2, tant qu'on ne met pas un autre nom dans la base, mais je voudrais que les donnees1 donnees2 donnees3 donnees4 et donnees6, qui ne sont pas liées mais saisies directement dans régime, soit effacées , à partir du moment ou le nom qui est dans la base et qui est lié dans régime est devenu =0 parce que effacé avant d'être modifié. Attention je ne veux pas que des lignes soient effacées mais simplement que des données soient effacées, données qui sont sur la même ligne mais qui ne se suivent pas forcément (je ne veux pas que données5 soit effacé...
Merci pour toute votre aide
Bonne journée
Philippe

 

[philmar]

Re : base

Bonjour,
en fait le code proposé par JOB51 marche bien,
par contre je voudrais que les cellules des colonnes D E F et I soient effacées,
Intersect(C1.EntireRow, Range("D:F")).ClearContents
Je ne sais pas comment ajouter I dans le Range (sans le G)

Un problème, quand on remplace le nom dans la base, sans l'effacer au préalable, ça n'efface pas car les formules ne deviennent pas 0...Il y a -t-il un moyen?
Bien cordialement
Philippe

 

[job75]

Re : base

Bonjour Philmar, le forum,

Bon, on va tenir compte de votre nouvelle demande.

Dans la macro précédente, il y a un inconvénient : Find ne trouve qu'une valeur 0 ou qu'une valeur #REF!, alors qu'il peut y en avoir plusieurs (quand une plage est effacée ou supprimée dans la 1ère feuille).

Le mieux est donc sans doute d'utiliser une boucle For...Next :

Private Sub Worksheet_Calculate()
On Error Resume Next
For Each Cel In Range("A2", Range("A65536").End(xlUp))
If Cel = 0 Then Intersect(Cel.EntireRow, Range("[COLOR="Red"]D:F,I:I[/COLOR]")).ClearContents
If IsError(Cel) Then Cel.EntireRow.Delete
Next
End Sub

A+

 

[philmar]

Re : base

Bonjour, ça marche, pour la multi sélection de cellules, merci!
mais j'ai peur que les utilisateurs ne se contentent que de modifier le nom, donc la cellule dans regime ne passe pas par le stade 0 et donc pas d'effacement.. Une possibilité?
Merci encore pour le temps que vous m'avez consacré !
Bien cordialement

 

[job75]

Re : base

Re,

J'ai un peu galéré, mais voici une macro qui fonctionne pour toute modification d'un nom dans la 1ère feuille.

Private Sub Worksheet_Calculate()
Dim Sel, Selmod As Range
Application.EnableEvents = False
On Error Resume Next
Set Sel = Selection
Application.Undo
Set Selmod = Intersect(Selection, Sheets("BASE").Range("B2:B65536"))
If Selmod Is Nothing Then Set Selmod = Range("A1")
Application.Undo
Sel.Select
For Each Cel In Range("A2", Range("A65536").End(xlUp))
If Not Intersect(Selmod, Sheets("BASE").Range(Replace(Cel.Formula, "=", ""))) Is Nothing Then _
Intersect(Cel.EntireRow, Range("D:F,I:I")).ClearContents
If IsError(Cel) Then Cel.EntireRow.Delete
Next
Application.EnableEvents = True
End Sub

Si vous souhaitez des explications sur ce code, n'hésitez pas à les demander.

A+

Edition : j'ai dû créer les 2 variables Sel et Selmod

 

[freefer]

Re : base

Bonjour,

Tu trouveras ci-joint ton programme auquel j'ai rajouté une combobox qui efface toutes les données comme tu l'as demandé, la restriction, c'est que sur les 2 feuilles les numéros de lignes soient identiques pour chaque patient.

Cordialement,

Freefer.

 

[philmar]

Re : base

Bonjour et merci beaucoup pour vos réponses JOB75 et FREEFER ;
Merci JOB75 ça marche à merveille, je vais l'adapter à ma base qui est assez importante pour nous! merci encore
Bonne journée
Philippe

 

[job75]

Re : base

Bonsoir à tous,

ça marche à merveille

Eh non, quand on supprime des lignes en feuille Base, la macro précédente ne fonctionne pas correctement.

J'ai donc sorti la recherche et la suppression des #REF! de la boucle For Each...Next. Voici la nouvelle mouture :

Private Sub Worksheet_Calculate() 'quand les formules de la feuille regime sont recalculées
Dim Sel, Selmod As Range
Application.EnableEvents = False
On Error Resume Next
Set Sel = Range("B1")
Set Sel = Range("A:A").SpecialCells(xlCellTypeFormulas, 16)
If Intersect(Sel, Range("B1")) Is Nothing Then
    Sel.EntireRow.Delete 'suppression des lignes avec valeur d'erreur
Else
    Set Sel = Selection 'de la feuille Base
    Application.Undo
    Set Selmod = Intersect(Selection, Sheets("BASE").Range("B2:B65536")) 'cellules modifiées feuille Base
    Application.Undo
    Sel.Select
    If Not Selmod Is Nothing Then
        For Each Cel In Range("A2", Range("A65536").End(xlUp))
            If Not Intersect(Selmod, Sheets("BASE").Range(Replace(Cel.Formula, "=", ""))) Is Nothing Then _
            Intersect(Cel.EntireRow, Range("D:F,I:I")).ClearContents
        Next
    End If
End If
Application.EnableEvents = True
End Sub

A+

 

[philmar]

Re : base

Bonsoir,
ça ne marche pas...ci-joint donc les deux onglets issus de la base, tout ce que je souhaite c'est que si un nom est supprimé ou modifié dans la base de C2 à C107 cela génère dans l'onglet ANIMATION HEBDO :
En face du nom (lié à la base) (cellules B6 à B111) cela efface la ligne avec les informations (cellules C à AB).
L'objectif dans cette base de donnée excel c'est que si on change un nom dans BASE, qu'on évite le risque de laisser les informations saisies dans l'onglet ANIMATION HEBDO et qui appartiennent à l'ancien nom...
j'espère que je suis assez explicite ...
Merci pour votre aide.
Bonne soirée
Philippe

 

[job75]

Re : base

Bonsoir Philmar,

L'adaptation de la macro à ce nouveau fichier n'est pas bien difficile.

Par ailleurs, comme vous avez des données en dessous des noms, au lieu de supprimer les lignes avec valeurs d'erreur, je les efface.

Comme la suppression de lignes, l'effacement suppose que la feuille ne soit pas protégée (si les cellules sont verrouillées).

L'ennui de votre fichier c'est que si vous ajoutez ou supprimez des lignes, il faut modifier à chaque fois la macro.

Private Sub Worksheet_Calculate() 'quand les formules de la feuille regime sont recalculées
Dim Sel, Selmod As Range
Application.EnableEvents = False
On Error Resume Next
Set Sel = Range("[COLOR="Red"]A1[/COLOR]")'parce que A1 n'est pas en colonne B
Set Sel = Range("[COLOR="Red"]B6:B111[/COLOR]").SpecialCells(xlCellTypeFormulas, 16)'recherche des valeurs d'erreur en colonne B
If Intersect(Sel, Range("[COLOR="Red"]A1[/COLOR]")) Is Nothing Then
[COLOR="Red"]Intersect(Sel.EntireRow, Range("A:AB")) = ""[/COLOR] 'effacement des lignes avec valeurs d'erreur
Else
Set Sel = Selection 'dans la feuille BASE
Application.Undo
Set Selmod = Intersect(Selection, Sheets("BASE").Range("[COLOR="Red"]C2:C107[/COLOR]")) 'cellules modifiées feuille BASE
Application.Undo
Sel.Select
If Not Selmod Is Nothing Then
For Each Cel In Range("[COLOR="Red"]B6:B111[/COLOR]")
If Not Intersect(Selmod, Sheets("BASE").Range(Replace(Cel.Formula, "=", ""))) Is Nothing Then _
Intersect(Cel.EntireRow, Range("[COLOR="Red"]C:AB[/COLOR]")) = ""' effacement cellules
Next
End If
End If
Application.EnableEvents = True
End Sub

Bonne nuit et A+

 

[philmar]

Re : base

Bonjour, que dire de plus, ça fonctionne, bravo job75, cela me sera très utile!
Bon week-end à tous et merci