Simplification de formules

Bonjour,

Je suis nouveau sur ce forum et novice surtout. J'ai besoin de votre aide car j'ai créé 3 macros mais quand je les exécute (le Bouton "analyse" puis le bouton "à payer" et enfin le bouton "Reset"), il faut une trentaine de secondes pour qu'elles donnent un résultat.

J'aimerais savoir s'il y a une possibilité de les simplifier, svp ?

Je vous joins le fichier.

Merci d'avance.

Edit dan : fichier remplacé. Le fichier posté contenait des données confidentielles

Bonjour,

Pas sûr d'y voir très clair dans ce que vous souhaitez réellement réalisé mais les boucles ne sont sûrement pas nécessaires.

Les 3 macros deviendraient :

Sub sélection()
ActiveSheet.Range("$A$10:$F$" & Worksheets("VN A PAYER").Cells(Worksheets("VN A PAYER").Rows.Count, 1).End(xlUp).Row).AutoFilter Field:=6, Criteria1:=RGB(146, _
    208, 80), Operator:=xlFilterCellColor
End Sub

Sub raz()
Range("A12:F" & Worksheets("VN A PAYER").Cells(Worksheets("VN A PAYER").Rows.Count, 1).End(xlUp).Row).ClearContents
End Sub

Sub test()
Application.Calculation = xlCalculationManual
Range("A12:F" & 12 + [A7]).FillDown
Application.Calculation = xlCalculationAutomatic
End Sub

Dans l'attente de votre retour.

Cdlt,

Bonjour

En fonction de votre demande et du code existant pour le bouton Analyse, j'aurais plutot vu ceci

Sub test()
Dim n As Integer, t As Integer

    n = Range("a7")
    t = Range("b7")
    Application.ScreenUpdating = False
    With ActiveSheet
        .Cells(12, 1).Resize(n, 1).EntireRow.Insert
        .Range("A11:F11").Copy Cells(12, 1).Resize(n, 1)
        .Range("A" & n + 12 & ":F" & n + 12).Copy .Cells(n + 12, 1).Resize(t, 1)
    End With
    Application.ScreenUpdating = True
End sub

Pour le reste, je n'ai pas regardé et je laisse la main à Ergotamine qui vous a proposé les autres codes également

Si besoin dites moi

cordialement

Merci DAN pour ta réactivité, ta macro convient parfaitement bien et est beaucoup plus rapide.

Merci.

En ce qui concerne la macro "raz", y aurait-il une possibilité de la simplifier aussi ?

Cette macro annule l'action des 2 autres.

Merci d'avance.

Bonjour ERGOTAMINE,

J'ai testé vos macros mais cela ne fonctionne pas, je vous remercie tout de même du temps que vous y avez passé.

Le but de mes macros est :

Pour la macro "Test"

Dans un premier temps, la macro doit insérer un nombre de ligne égale à la cellule A7 à partir de la ligne 12 puis copier la ligne 11 sur les lignes insérées.

Dans un deuxième temps, la macro doit copier sur la ligne 12 + la cellule A7 la ligne qui est au départ la ligne 12 sur le nombre de la cellule B7.

Pour la macro "Sélection"

Filtrer les cellule en vert de la colonne F

Pour la macro "raz"

annulation des 2 macros pour revenir au départ.

J'espère avoir été plus clair.

Merci encore pour votre travail.

re

J'ai remplacé votre fichier en supprimant les colonnes i et j dans votre feuille Quotidienne, il y avait des données confidentielles

Question : vous êtes sous MAC ? Je vois des ? un peu partout

Bonjour, Bonjour Dan,

Je m'étais trompé dans le nombre de ligne désolé. Par contre je ne comprend pas l'insertion de lignes qui ralenti, je pense, l’exécution (modification de la structure de la feuille).

Un nouveau test :

Sub sélection()
ActiveSheet.Range("$A$10:$F$" & Worksheets("VN A PAYER").Cells(Worksheets("VN A PAYER").Rows.Count, 1).End(xlUp).Row).AutoFilter Field:=6, Criteria1:=RGB(146, 208, 80), Operator:=xlFilterCellColor
End Sub

Sub raz()
Range("A12:F" & Worksheets("VN A PAYER").Cells(Worksheets("VN A PAYER").Rows.Count, 1).End(xlUp).Row).ClearContents
Range("F11").FormatConditions(1).ModifyAppliesToRange Range("F11")
End Sub

Sub test()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Range("A11:F" & 11 + [A7]).FillDown
Range("F11").FormatConditions(1).ModifyAppliesToRange Range("F11:F" & 11 + [A7])
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Sur la macro test, j'arrive au même résultat que Dan je ne comprend pas pourquoi ça ne fonctionnerais pas. Dans si tu vois une erreur dans ma dernière macro n'hésite pas !

Merci !

Edit : Il est peut être aussi opportun de passer par une table structurée à l'avenir si beaucoup de données.

Ok pour le Fichier et désolé pour les données confidentielles, je n'avais pas fais le rapprochement.

Pour répondre à votre question, je suis sur PC.

Par contre pour la macro "RAS", il faudrait supprimer les lignes écrites et non supprimer les contenus des cellules pour retrouver l'ergonomie de départ.

Merci d'avance.

Bonjour,

Normalement c'est ce qu'elle fait via l'instruction Range("A12:F"& , supprimer toutes les lignes en dessous de la ligne 11, donc de 12 jusqu'à la fin.

Me confirmez vous ça ?

Cdlt,

Re

YAN54 a écrit :

Ok pour le Fichier et désolé pour les données confidentielles, je n'avais pas fais le rapprochement.Pour répondre à votre question, je suis sur PC

Ok merci pour la précision PC et pas de souci pour le fichier. Cela peut arriver

En ce qui concerne la macro "raz", y aurait-il une possibilité de la simplifier aussi ?

@Ergotamine : je pense que c'est ceci qu'il veut avoir pour conserver les deux lignes que l'on voit dans son fichier qu'il a posté au départ

Sub raz()

Dim n As Byte
With ActiveSheet
    If .Range("A" & Rows.Count).End(xlUp).Row > 12 Then
        n = Range("a4")
        .Range(.Rows(12 + n), .Rows(12 + n).End(xlDown)).Delete Shift:=xlUp
        .Rows(12 & ":" & 12 + n - 2).Delete Shift:=xlUp
    End If
End With
End Sub

Cordialement

Aaaaah mais oui je n'avais pas vu la distinctions de formule entre les 2 lignes (bien que je n'en comprenne pas la subtilité) c'est ce qui m'a induit en erreur autant pour moi désolé pour vous avoir fait perdre votre temps à tout les deux.

Merci beaucoup Dan, tu me fais penser qu'il faut que j'aille chez l'opticien :)

Bonne soirée !

Re

Merci beaucoup Dan, tu me fais penser qu'il faut que j'aille chez l'opticien :)

Lol ! j'y suis allé il y a 4 mois... peut être à cause de cela que je l'ai vu ... la vieillesse ou plutot l'âge n'aide pas....

Bon YAN il est où ?