Remplacer formules par un code VBA

criscris11 · 30 Juillet 2008

Bonsoir à tous,
J'aimerai dans le fichier-joint remplacer les formules matricielles par une extraction VBA sans toucher à la mise en page.
J'ai mis les commentaires dans le fichier.

PS : il ne faut pas que l'on retrouve les formules après l'exécution du code car le but étant d'éviter le calcul automatique à chaque saisie.
Merci d'avance et bonne soirée.

J'ai oublié de préciser mais dans la feuille des présents, des lignes peuvent être insérées ou supprimées.

bbanor · 30 Juillet 2008

Re : Remplacer formules par un code VBA

Salut

As tu essayer l'enregistreur de macro?

Qui me paraît la méthode la plus directe pour avoir tes formules intégré dans ta macro.

A te lire

criscris11 · 30 Juillet 2008

Re : Remplacer formules par un code VBA

Bonsoir bbanor,
Oui bien sûr, c'est même la première chose que j'ai fait mais je ne veux pas que les formules soient de nouveau présentes dans la plage concernée.
Merci quand même et bonne soirée.

BOISGONTIER · 30 Juillet 2008

Re : Remplacer formules par un code VBA

Bonsoir,

Pourquoi pas le filtre élaboré?

JB

criscris11 · 30 Juillet 2008

Re : Remplacer formules par un code VBA

Re, bonsoir Jacques,
Oui effectivement j'y avais pensé mais cela ne vas t'il pas modifier la ligne d'entête dans la feuille SPA ? Car si je me rappelles bien pour le filtre élaboré, il faut choisir les critères manuellement avant de lancer le filtre élaboré.
Si ce n'est pas le cas, je suis preneur d'une petite explication comment procéder.
Merci à toi et bonne soirée.

JCGL · 30 Juillet 2008

Re : Remplacer formules par un code VBA

Bonjour à tous,
Salut Cris 🙂,

Je te propose ceci pour mettre en matricielle ta formule en B :

Code:

Range("B34").FormulaArray = _
        "=INDEX(PrColNom,MIN(IF(PrDebut<=R1C[4],IF(OR(PrFin>=R1C[4],PrFin=""""),IF(PrMotif<>"""",IF(COUNTIF(R33C:R[-1]C,PrNom)=0,ROW(PrNom)))))))&"""""
    Range("B34:B200").FillDown

Ensuite tu fais un Copier / Collage Spécial / Valeurs.

Pour la MaJ, tu remets la formule.

Si j'ai tout compris...

Bises chez toi
A+ à tous

criscris11 · 30 Juillet 2008

Re : Remplacer formules par un code VBA

Re, salut JC,
Je ne sais pas si ta proposition va correspondre à mon besoin mais vais tester cà après le biberon 😉.
Merci l'ami et amitiés à toi.

criscris11 · 30 Juillet 2008

Re : Remplacer formules par un code VBA

JC,
Je viens de tester : dans mon cas il suffirait donc de procéder ainsi pour les autres colonnes jusqu'à F.
C'est une piste intéressante ma foi, je te tiens au courant pour la suite.
Bonne soirée.

ChTi160 · 30 Juillet 2008

Re : Remplacer formules par un code VBA

Salut criscris11
Bonsoir le fil
Bonsoir le Forum

Arff je ne sais pas si j'ai bien compris Lol
En pièce jointe une version VBA de ce que j'ai compris ?????
J'ai mis le bouton en feuille SPA ,on peut aussi bien le mettre dans l'autre

Le Fichier :Regarde la pièce jointe ExtractionV1.zip

Bonne fin de Soirée

criscris11 · 30 Juillet 2008

Re : Remplacer formules par un code VBA

Salut Jean-Marie, re le fil,
Merci d'avoir rejoint ce fil qui plus est avec un code tout à fait approprié à mon souhait : tu as parfaitement compris ce que je voulais.
Je t'en remercie et te souhaite une bonne soirée.

Je poste mon code fabriqué à partir de l'idée de JC, alors si vous voyez quelque chose qui cloche n'hésitez pas.
Merci encore à tous les deux et à tous ceux qui ont participé d'une manière ou d'une autre.

Code:

Sub SPA ()

    Application.ScreenUpdating = False
    Sheets("SPA").Select
    Range("B34:F200").Select
    Selection.ClearContents
    Range("B34").FormulaArray = _
        "=INDEX(PrColNom,MIN(IF(PrDebut<=R1C[4],IF(OR(PrFin>=R1C[4],PrFin=""""),IF(PrMotif<>"""",IF(COUNTIF(R33C:R[-1]C,PrNom)=0,ROW(PrNom)))))))&"""""
    Range("B34:B200").FillDown
    Range("C34").FormulaArray = _
        "=IF(RC[-1]="""","""",INDEX(PrMotif,MIN(IF(PrDebut<=R1C[3],IF(OR(PrFin>=R1C[3],PrFin=""""),IF(PrMotif<>"""",IF(PrNom=RC[-1],ROW(PrNom))))))-2)&"""")"
    Range("C34:C200").FillDown    
    Range("D34").FormulaArray = _
        "=IF(RC[-2]="""","""",INDEX(PrLieu,MIN(IF(PrDebut<=R1C[2],IF(OR(PrFin>=R1C[2],PrFin=""""),IF(PrMotif<>"""",IF(PrNom=RC[-2],ROW(PrNom))))))-2)&"""")"
    Range("D34:D200").FillDown
    Range("D34").FormulaArray = _
            "=IF(RC[-3]="""","""",INDEX(PrDebut,MIN(IF(PrDebut<=R1C[1],IF(OR(PrFin>=R1C[1],PrFin=""""),IF(PrMotif<>"""",IF(PrNom=RC[-3],ROW(PrNom))))))-2))"
    Range("E34:E200").FillDown
    Range("D34").FormulaArray = _
        "=IF(RC[-4]="""","""",INDEX(PrFin,MIN(IF(PrDebut<=R1C,IF(OR(PrFin>=R1C,PrFin=""""),IF(PrMotif<>"""",IF(PrNom=RC[-4],ROW(PrNom))))))-2))"
    Range("F34:F200").FillDown    
    Range("B34:F200").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("F1").Select
    Application.ScreenUpdating = True
        
End Sub

JCGL · 31 Juillet 2008

Re : Remplacer formules par un code VBA

Bonjour à tous,
Salut Cris 🙂,

Il me semble que le code de ChTi est plus adapté mais si tu souhaites par formules.

Essaye ceci, un peu plus court (Evite les .Select suivi d'un Selection. quand c'est possible)
Tu as des erreurs de cellules (D34 est écrasé et copié en F:F)

Code:

Option Explicit
Sub SPA()
  Application.ScreenUpdating = False
    Sheets("SPA").Activate
    Range("B34:F200").ClearContents
    Range("B34").FormulaArray = _
        "=INDEX(PrColNom,MIN(IF(PrDebut<=R1C[4],IF(OR(PrFin>=R1C[4],PrFin=""""),IF(PrMotif<>"""",IF(COUNTIF(R33C:R[-1]C,PrNom)=0,ROW(PrNom)))))))&"""""
    Range("B34:B200").FillDown
 
    Range("C34").FormulaArray = _
        "=IF(RC[-1]="""","""",INDEX(PrMotif,MIN(IF(PrDebut<=R1C[3],IF(OR(PrFin>=R1C[3],PrFin=""""),IF(PrMotif<>"""",IF(PrNom=RC[-1],ROW(PrNom))))))-2)&"""")"
    Range("C34:C200").FillDown
 
    Range("D34").FormulaArray = _
        "=IF(RC[-2]="""","""",INDEX(PrLieu,MIN(IF(PrDebut<=R1C[2],IF(OR(PrFin>=R1C[2],PrFin=""""),IF(PrMotif<>"""",IF(PrNom=RC[-2],ROW(PrNom))))))-2)&"""")"
    Range("D34:D200").FillDown
 
    Range("E34").FormulaArray = _
            "=IF(RC[-3]="""","""",INDEX(PrDebut,MIN(IF(PrDebut<=R1C[1],IF(OR(PrFin>=R1C[1],PrFin=""""),IF(PrMotif<>"""",IF(PrNom=RC[-3],ROW(PrNom))))))-2))"
    Range("E34:E200").FillDown
 
    Range("F34").FormulaArray = _
        "=IF(RC[-4]="""","""",INDEX(PrFin,MIN(IF(PrDebut<=R1C,IF(OR(PrFin>=R1C,PrFin=""""),IF(PrMotif<>"""",IF(PrNom=RC[-4],ROW(PrNom))))))-2))"
    Range("F34:F200").FillDown
 
    With Range("B34:F200")
        .Copy
        .PasteSpecial Paste:=xlPasteValues
    End With
    Application.CutCopyMode = False
    Range("F1").Select
    Application.ScreenUpdating = True
 
End Sub

A+ et Bises chez toi
A+ à tous

criscris11 · 31 Juillet 2008

Re : Remplacer formules par un code VBA

Re,
JC : merci pour ton retour. Concernant ceci " Tu as des erreurs de cellules (D34 est écrasé et copié en F:F)", je m'en suis rendu compte à l'exécution du code et j'ai rectifié.
Il est vrai que le code de JM est plus adapté mais il faut que je regarde plus en détail car j'ai une différence à l'extraction.
En conclusion, ce fil n'est pas fermé et je reviendrai vous dire quelles sont les lignes qui manquent dans l'extraction via le code de JM.

Bonne soirée.

criscris11 · 31 Juillet 2008

Re : Remplacer formules par un code VBA

Re,
J'ai trouvé l'erreur dans le code de JM : il y a une ligne qui n'est pas extraite car il n'y a pas de date de fin renseignée or des fois on ne connais pas la date de fin mais il faut quand même que les lignes soient extraites.
Par contre, je ne sais pas comment le rajouter dans le code. Merci.

Bonne soirée.

ChTi160 · 31 Juillet 2008

Re : Remplacer formules par un code VBA

Salut
Bonsoir le fil
Bonsoir le Forum

effectivement,j'avais remarqué que le code de JC (que j'ai un peu modifié Lol)prenait en compte les dates seules (Ligne 65 de l'extraction) même si l'on ne sait pas si c'est un jour unique ou pas donc j'ai cru comprendre que quelque soit la date seule il faut la prendre en compte ??????

je vais regarder si je peux adapter le code de mon fichier

ci dessous la procédure de JC modifiée (moins de code, moins de lignes , moins de poids Lol ) on peut ainsi la lancer de la feuille Feuille des présents

Code:

Sub SPA()
  Application.ScreenUpdating = False
With Sheets("SPA")
      
    .Range("B34:F200").ClearContents
    .Range("B34").FormulaArray = _
        "=INDEX(PrColNom,MIN(IF(PrDebut<=R1C[4],IF(OR(PrFin>=R1C[4],PrFin=""""),IF(PrMotif<>"""",IF(COUNTIF(R33C:R[-1]C,PrNom)=0,ROW(PrNom)))))))&"""""
   
    .Range("C34").FormulaArray = _
        "=IF(RC[-1]="""","""",INDEX(PrMotif,MIN(IF(PrDebut<=R1C[3],IF(OR(PrFin>=R1C[3],PrFin=""""),IF(PrMotif<>"""",IF(PrNom=RC[-1],ROW(PrNom))))))-2)&"""")"
   
    .Range("D34").FormulaArray = _
        "=IF(RC[-2]="""","""",INDEX(PrLieu,MIN(IF(PrDebut<=R1C[2],IF(OR(PrFin>=R1C[2],PrFin=""""),IF(PrMotif<>"""",IF(PrNom=RC[-2],ROW(PrNom))))))-2)&"""")"
    
    .Range("E34").FormulaArray = _
            "=IF(RC[-3]="""","""",INDEX(PrDebut,MIN(IF(PrDebut<=R1C[1],IF(OR(PrFin>=R1C[1],PrFin=""""),IF(PrMotif<>"""",IF(PrNom=RC[-3],ROW(PrNom))))))-2))"
   
    .Range("F34").FormulaArray = _
        "=IF(RC[-4]="""","""",INDEX(PrFin,MIN(IF(PrDebut<=R1C,IF(OR(PrFin>=R1C,PrFin=""""),IF(PrMotif<>"""",IF(PrNom=RC[-4],ROW(PrNom))))))-2))"
    
     .Range("B34:F34").AutoFill Destination:=.Range("B34:F200")
    
     .Range("B34:F200").Value = .Range("B34:F200").Value
        
       
    End With
     
    Application.ScreenUpdating = True
 
End Sub

Bonne fin de Soirée
Ps il n'y a que la date de début qui peut être seule ????

criscris11 · 31 Juillet 2008

Re : Remplacer formules par un code VBA

Bonsoir JM,
Merci pour ce remaniement du code de JC qui va certainement l'alléger 😛.
Si cela peut t'aider concernant "si l'on ne sait pas si c'est un jour unique" : dans le cas d'un jour unique, la date de début de de fin sont remplies avec la même date : élémentaire mon cher Jean-Marie 😀.
En attendant merci et bonne soirée.

Réponse à ton édition : oui il n'y a que la date de début qui peut être seule.

Remplacer formules par un code VBA

criscris11

XLDnaute Accro

Pièces jointes

bbanor

XLDnaute Occasionnel

criscris11

XLDnaute Accro

BOISGONTIER

XLDnaute Barbatruc

criscris11

XLDnaute Accro

JCGL

XLDnaute Barbatruc

criscris11

XLDnaute Accro

criscris11

XLDnaute Accro

ChTi160

XLDnaute Barbatruc

Pièces jointes

criscris11

XLDnaute Accro

JCGL

XLDnaute Barbatruc

criscris11

XLDnaute Accro

criscris11

XLDnaute Accro

ChTi160

XLDnaute Barbatruc

criscris11

XLDnaute Accro

Discussions similaires

Remplacer formules par un code VBA

XLDnaute Accro

Pièces jointes

XLDnaute Occasionnel

XLDnaute Accro

XLDnaute Barbatruc

XLDnaute Accro

XLDnaute Barbatruc

XLDnaute Accro

XLDnaute Accro

XLDnaute Barbatruc

Pièces jointes

XLDnaute Accro

XLDnaute Barbatruc

XLDnaute Accro

XLDnaute Accro

XLDnaute Barbatruc

XLDnaute Accro

Discussions similaires

Privacy & Transparency

Privacy & Transparency