Discussion :

[kelly27]

Bonsoir

Je sollicite votre aide pour remplacer les nombreuses formules de mon projet par des codes VBA. N’étant pas trop à l’aise avec les VBA, je vous joins un fichier test.
Les formules ainsi traduites en VBA permettraient de réduire la taille du fichier et de gagner en rapidité de calcul.
Merci de votre aide

[Invité]

Bonjour

Il serait préférable de donner des explications qu'une pièce jointe que beaucoup de membres ne pourront ouvrir.

Philippe

[kelly27]

Bonjour
Désolée , je pensais qu’avec une pièce jointe , mes explications seraient plus simple.
En fait j’ai une base de données état civil professionnel( Nom , Affectation, fonction, statut) que je renseigne par un formulaire.
J’utilise des formule SI et SI(et telles que

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=SI(ET(B2="Infirmier";C2="ZONE A");SI(OU(D2="titulaire";D2="stagiaire";D2="Contractuel CDI");1))

pour trier les agents par zone d’affectation.
Je me retrouve avec une formule par ligne et multipliée par le nombre de zone et d’agents , Ca monte vite en milliers.
Je sollicite votre aide pour me faire une ébauche de macros , je pourrais ainsi avoir une piste et continuer le reste.
Merci Beaucoup

[kelly27]

vous en pensez quoi?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub formules()
 
Dim DernLigne As Long
 
Sheets("BDD").Select
DernLigne = Range("v" & Rows.Count).End(xlUp).Row
Range("V2:BRX2").AutoFill Destination:=Range("V2:BRX2" & DernLigne)
 
End Sub

je dois certainement mal m'y prendre , (vu le nombre de réponses que j'ai). Allez j'insiste quand meme...au seeeeecoouuurs!!!!!!

j'ai tenté ce code ;

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub formules()
 
Dim DernLigne As Long
 
Sheets("DONNEES").Select
DernLigne = Range("A" & Rows.Count).End(xlUp).Row
Range("E2:X2").AutoFill Destination:=Range("E2:X2" & DernLigne)
 
End Sub

Mais il me recopie les formules et au final , j'obtiens la meme chose que si j'avais etiré vers le bas

je pensais aussi à formulalocal .

merci de m'aider chers membres du forum

[Marc-L]

Bonjour, bonjour !

Déjà il faudrait corriger la destination !

Ligne n°7 : Msgbox "E2:X2" & DernLigne permettrait de le constater …

Ensuite il faudrait expliquer ce qu'est censé effectuer le code !

[kelly27]

Bonsoir

En passant par l’enregistreur de macro, je suis parvenue à trouver un début de solution.

Voila le code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub Formules()
With Worksheets("DONNEES")
 
    Range("E2").FormulaR1C1 = _
        "=IF(AND(RC[-3]=""infirmiére"",RC[-2]=""ZONE A""),IF(OR(RC[-1]=""titulaire"",RC[-1]=""stagiaire"",RC[-1]=""Contractuel CDI""),1,0))"
   Range("E2").FormulaR1C1 = Range("E2").Value
 
  Range("F2").FormulaR1C1 = _
        "=IF(AND(RC[-4]=""Agent de Service hospitalier"",RC[-3]=""ZONE A""),IF(OR(RC[-2]=""titulaire"",RC[-2]=""stagiaire"",RC[-2]=""Contractuel CDI""),1))"
   Range("F2").FormulaR1C1 = Range("F2").Value
 
 
 
   Range("G2").FormulaR1C1 = _
        "=IF(AND(RC[-5]=""Aide-Soignant"",RC[-4]=""ZONE A""),IF(OR(RC[-3]=""titulaire"",RC[-3]=""stagiaire"",RC[-3]=""Contractuel CDI""),1))"
       Range("G2").FormulaR1C1 = Range("G2").Value
       End With
End Sub

Il ne s’applique que sur la première ligne (2)
Comment l’appliquer sur toutes les lignes jusqu'à la dernière non vide ?
Je vous joins un fichier en exemple.

Merci de votre aide

[Marc-L]

Voici une possibilité parmi d'autres :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Formules()
    With Feuil4.Cells(1).CurrentRegion
        If .Columns.Count < 7 Or .Rows.Count = 1 Then Exit Sub
        Application.ScreenUpdating = False
        .Cells(2, 5).FormulaR1C1 = "=IF(AND(RC[-3]=""infirmiére"",RC[-2]=""ZONE A""),IF(OR(RC[-1]=""Titulaire"",RC[-1]=""Stagiaire"",RC[-1]=""Contractuel CDI""),1,""""),"""")"
        .Cells(2, 6).FormulaR1C1 = "=IF(AND(RC[-4]=""Agent de Service hospitalier"",RC[-3]=""ZONE A""),IF(OR(RC[-2]=""Titulaire"",RC[-2]=""Stagiaire"",RC[-2]=""Contractuel CDI""),1,""""),"""")"
        .Cells(2, 7).FormulaR1C1 = "=IF(AND(RC[-5]=""Aide-Soignant"",RC[-4]=""ZONE A""),IF(OR(RC[-3]=""Titulaire"",RC[-3]=""Stagiaire"",RC[-3]=""Contractuel CDI""),1,""""),"""")"
 
        With .Cells(2, 5).Resize(.Rows.Count - 1, 3)
            .Rows(1).AutoFill .Rows, xlFillCopy
            .Value = .Value
        End With
    End With
End Sub

__________________________________________________________________________________________

Merci de cliquer sur pour chaque message ayant aidé puis sur pour clore cette discussion …

[kelly27]

Merci Marc L pour votre aide.

J’ai configuré le code et il répond très bien à mes besoins. Du fait de mes nombreuses formules, j’ai du le diviser en plusieurs macros.
Pourriez-vous m’aider à configurer leur exécution à l’ouverture du classeur ?
J’ai essayé worbook-open avec call macro….mais ça ne marche pas.

Bien cordialement

[Marc-L]

Oui c'est bien pourtant dans l'évènement Workbook_Open …

Peut-être attendre que l'application soit prête via la propriété Ready avant de lancer la procédure …

[kelly27]

Bonjour

Pourrais tu m'en dire plus sur la propriété ready?

Surement un début de piste

cordialement

[Marc-L]

Pas plus que précédemment, voir l'aide VBA intégrée (et son exemple). Effectivement, c'est juste une piste à explorer …

[kelly27]

Bonjour
j'essaye ce code mais la macro ne s'éxexute pas quand la valeur d'une cellule change

Code placé dans l'évenement worksheets de la feuille données

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
i = ActiveCell.Row
If Target.Address = Cells(i, 1).Address Then
Call MACRO
End If
End Sub]

Bien cordialement

[Marc-L]

Quelle cellule ?

Sans explication … Faudrait peut-être revoir la logique du code …

[kelly27]

Bonjour
Ainsi finalement, je me suis rabattue sur ce code qui fonctionne plutôt bien.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Not Application.Intersect(Target, Range("plage")) Is Nothing Then
Call Mamacro
End If
End Sub

"Plage" correspond à la zone ou se trouve la cellule modifiée en entrant les données par formulaire.

Mamacro exécute le rafraichissement de la feuille et affiche les nouvelles valeurs.

Le problème c’est que Mamacro recalcule toutes les lignes de la feuille, alors que l’idéal ce serait de recalculer uniquement la ligne ou se trouve la cellule à la valeur modifiée.
En s’exécutant sur toute la feuille (presque un millier de formules), cela provoque un ralentissement qui, je pense, pourrait être évitée.
Comment cibler la cellule modifiée et appliquer la macro uniquement sur la ligne de ladite cellule ?

Merci de votre aide
Cordialement

[Marc-L]

J'ai aussi pensé à cette solution au début mais vu la demande …

Donc dans l'évènement ne surtout pas appeler la macro ‼

Calculer juste le nécessaire suite à la modification par rapport à son n° de ligne : Target.Row …

[kelly27]

Merci

Je suis dans une impasse Totale.
Pourriez vous m'aider a ecrire le code?

Bien Cordialement

[Marc-L]

Copier les formules à la place d'appeler la macro et y utiliser Target.Row pour le numéro de la ligne …

[kelly27]

Auriez vous une astuce pour éviter l'erreur " procédure trop grande " car il ya trop de formules dans l'événement Private Sub Worksheet_Change(ByVal Target As Excel.Range)

Est ce que cette formule conviendrait .

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
i = ActiveCell.Row
If Target.Address = Cells(i, 1).Address Then
‘toutes les Formules
End If

Bien cordialement

[parmi]

Bonjour,

Dans ThisWorkbook, mets ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Private Sub Workbook_Open()
    Call Formules
End Sub

Dans un module, mets ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Sub Formules()
    Dim nbLignes As Long
 
    Sheets("DONNEES").Activate
    nbLignes = Cells(Rows.Count, "A").End(xlUp).Row
 
    Range("E2:E" & nbLignes).Formula = "=IF(AND(B2=""Infirmier"",C2=""ZONE A""),IF(OR(D2=""titulaire"",D2=""stagiaire"",D2=""Contractuel CDI""),1,0),0)"
    Range("F2:F" & nbLignes).Formula = "=IF(AND(B2=""Agent de Service hospitalier"",C2=""ZONE A""),IF(OR(D2=""titulaire"",D2=""stagiaire"",D2=""Contractuel CDI""),1,0),0)"
    '....
    'Même principe pour les autres colonnes
    'Copier en valeur à la fin
End Sub

À noter que j'emploie Formula et donc, la virgule comme séparateur, les termes anglais et des double-guillemets pour le texte
À la fin de la macro, il ne te reste qu'à copier/coller en valeur pour éviter le recalcul continuel.
Par contre, tes formules ne se regénèreront pas lorsqu'il y aura des changements...

Si tu veux faire ce genre de choses sur l'événement _Change(), à chaque fois que tu changeras une valeur il y aura répétition de ce _Change()
Pour éviter ça, il faut que tu utilises Application.EnableEvents à False au début et True à la fin de cette procédure _Change() ou encore une variable booléenne qui empêche de continuer le cas échéant...

NB: j'ai mis des 0 dans la formule, mais ça pourrait être changé par des guillemets si tu préfères.
Ne pas oublier de les doubler par contre...

[Marc-L]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub Worksheet_Change(ByVal Target As Range)
    With Target
        If .Column > 1 And .Column < 5 And .Row > 1 Then
            With Application:  .EnableEvents = False:  .ScreenUpdating = False:  End With
            Cells(.Row, 5).FormulaR1C1 = "=IF(AND(RC[-3]=""infirmiére"",RC[-2]=""ZONE A""),IF(OR(RC[-1]=""Titulaire"",RC[-1]=""Stagiaire"",RC[-1]=""Contractuel CDI""),1,""""),"""")"
            Cells(.Row, 6).FormulaR1C1 = "=IF(AND(RC[-4]=""Agent de Service hospitalier"",RC[-3]=""ZONE A""),IF(OR(RC[-2]=""Titulaire"",RC[-2]=""Stagiaire"",RC[-2]=""Contractuel CDI""),1,""""),"""")"
            Cells(.Row, 7).FormulaR1C1 = "=IF(AND(RC[-5]=""Aide-Soignant"",RC[-4]=""ZONE A""),IF(OR(RC[-3]=""Titulaire"",RC[-3]=""Stagiaire"",RC[-3]=""Contractuel CDI""),1,""""),"""")"
            With Cells(.Row, 5).Resize(, 3):  .Value = .Value:  End With
            Application.EnableEvents = True
        End If
    End With
End Sub

Kelly27, ton instruction Call Formules dans l'évènement Workbook_Open de ton classeur fonctionne de mon côté !

_________________________________________________________________________________________________

Merci de cliquer sur pour chaque message ayant aidé puis sur pour clore cette discussion …