Formules texte en VBA

Version imprimable

08/12/2014, 00h46
kelly27

1 pièce(s) jointe(s)

Formules texte en VBA

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
08/12/2014, 07h42
Invité

Bonjour

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

Philippe
08/12/2014, 13h41
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:

=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

vous en pensez quoi?
Code:

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:

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

09/12/2014, 10h44
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 !

1 pièce(s) jointe(s)

Bonsoir

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

Voila le code

Code:

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

Voici une possibilité parmi d'autres :

Code:

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 :plusser: pour chaque message ayant aidé puis sur :resolu: pour clore cette discussion …

12/12/2014, 00h17
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
12/12/2014, 00h34
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 …
12/12/2014, 06h41
kelly27

Bonjour

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

Surement un début de piste

cordialement
12/12/2014, 15h25
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 …
13/12/2014, 08h32
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:

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
14/12/2014, 19h57
Marc-L

Quelle cellule ?

Sans explication … Faudrait peut-être revoir la logique du code …
15/12/2014, 09h04
kelly27
Bonjour
Ainsi finalement, je me suis rabattue sur ce code qui fonctionne plutôt bien.
Code:

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
15/12/2014, 13h14
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 …
15/12/2014, 15h31
kelly27

Merci

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

Bien Cordialement
15/12/2014, 16h47
Marc-L

Copier les formules à la place d'appeler la macro et y utiliser Target.Row pour le numéro de la ligne …
15/12/2014, 19h52
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:

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

Bonjour,

Dans ThisWorkbook, mets ceci
Code:

1 2 3 Private Sub Workbook_Open() Call Formules End Sub
Dans un module, mets ceci
Code:

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...

Code:

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 :plusser: pour chaque message ayant aidé puis sur :resolu: pour clore cette discussion …