XL 2019 Lenteur macro (nouveau cas)

[Cheyenne_2021]

Bonjour,

La macro est longue je dirais presque 30 sec !

Un fichier avec 6 onglets, sur chacun un tableau structuré de 360 lignes.

Lecture 1er onglet, toutes les lignes, si le statut est = SUPP

Alors

Suppression de la ligne

Onglet 2 :Recherche de la ligne concernée avec RechercheV, suppression de la ligne

Onglet 3 :Recherche de la ligne concernée avec RechercheV, suppression de la ligne

Onglet 4 :Recherche de la ligne concernée avec RechercheV, suppression de la ligne

Onglet 5 :Recherche de la ligne concernée avec RechercheV, suppression de la ligne

Onglet 6 :Recherche de la ligne concernée avec RechercheV, suppression de la ligne

fin



Je ne peux pas utiliser l’accélérateur de Recherche V (avec un SI) par car mes n° ne sont pas triés

Je n’ai pas de Macro "évènementielle superfétatoire".

Je ne peux pas vous mettre le fichier car il est trop lourd, je vous recopie la macro. Je ne mets qu’un des call car ils sont tous strictement identiques.



Public Num_S As Integer

Sub Supprimer_ASUPP()


Call Initialisation_Variables_Public



Application.Calculation = xlCalculationManual

Application.ScreenUpdating = False



Application.DisplayAlerts = False

Dim r As Integer ' indice des lignes dans le tableau T_suivi_DI

'Paramètres pour le RechercheV

Dim numero As Variant

Dim Tableau_num As Range

Dim num_col As Single

Dim valeur_proche As Boolean

indice = ""



Call Deverrouiller_feuille(ActiveWorkbook.Worksheets("1- Suivi des DI & avis n+1"))



Di_Ligne = Range("T_suiviDi").Rows.Count


For r = 1 To Di_Ligne

col_statut = Worksheets("1- Suivi des DI & avis n+1").ListObjects("T_SuiviDi").ListColumns("Statut").Index

col_num = Worksheets("1- Suivi des DI & avis n+1").ListObjects("T_SuiviDi").ListColumns("NumL").Index


If [T_SuiviDi[statut]].Rows(r) = "ASUPP" Then

Num_S = [T_SuiviDi[NumL]].Rows(r)

derniere_ligne = [T_SUPP].ListObject.ListRows.Count

[T_SUPP].ListObject.ListRows.Add

[T_SuiviDi].Rows(r).Copy

[T_SUPP].Rows(derniere_ligne).PasteSpecial Paste:=xlPasteValues

[T_SUPP].Rows(derniere_ligne).PasteSpecial Paste:=xlPasteFormats

'suppression de la ligne dans les onglets 2-3-4-5-6

' ---------------------------------------------------

Call supp_2(Num_S)

Call supp_3(Num_S)

Call supp_4(Num_S)

Call supp_5(Num_S)

Call supp_6(Num_S)


End If

Next


Application.ScreenUpdating = True

Application.Calculation = xlCalculationAutomatic

Application.DisplayAlerts = True



Call Verouiller_feuille(ActiveWorkbook.Worksheets("1- Suivi des DI & avis n+1"))

End Sub



Sub supp_2(Num_S As Integer)

Call Deverrouiller_feuille(Onglet_TraitDi)


'Parametres pour le RechercheV

Dim numero As Variant

Dim Tableau_num As Range

Dim num_col As Single

Dim valeur_proche As Boolean

indice = ""

numero = Num_S

Set Tableau_num = Worksheets("2- Traitement des DI").Range("T_TraitDi")

valeur_proche = False

indice = ""

num_col = 1 ' n° de la colone ou est numero

DL_2 = [T_TraitDi].ListObject.ListRows.Count

indice = RECHERCHEV(numero, Tableau_num, num_col, valeur_proche)

'RECHERCHEV_F = WorksheetFunction.VLookup(num_rat, Tableau_num, 2, 0)


If indice <> "#N/A" Then 'numero TW trouvé

' n° de ligne du tableau où il a trouvé le n°

numero2 = Application.Match(Num_S, [T_TraitDi[NumL]], 0)

[T_TraitDi].Rows(numero2).Delete

End If

Call Verouiller_feuille(Onglet_TraitDi)

End Sub

Merci,

 

[Cheyenne_2021]

D'abord merci !

• Pour les déverrouillages et reverouillages, je comprends qu'il est plus rapide mettre le code directement dans la macro plutôt que faire des appels à des sous-macro.
• Je ne comprends pas le Iserror(indice) puisque tu n'utilises plus la variable indice.
  • If Not IsError(indice) Then 'numero TW trouvé
    .ListRows(i).Range.Delete 'Interior.ColorIndex = 6
• Je ne peux pas faire la recherche sur le nom car il y a des doublons; je suis obligée de la faire sur Numl qui est unique.
• que veux-tu dire par "pb de formules dans l'onglet 5" ?
• Je vais essayer le FIND !

 

[ChTi160]

Re
Ok je regarde pour la recherche !
dans l'onglet 5 les formules dans mon fichier n'étaient pas fonctionnelles !
jean marie