Discussion :

[joe.levrai]

J'utilise très souvent l'export d'une table avec filtre avancé et suppression de l'ancienne feuille.
Le temps est relativement bref

un sujet où j'illustrais la mécanique avec création (et suppression) de la zone de critère : https://www.developpez.net/forums/d1...s/#post8499166

[retraite83]

Je rejoins l'analyse de Pierre Fauconnier, ma fille sera enchantée d'avoir ce petit logiciel qui va lui permettre de passer une commande en un rien de temps (une petite demi-heure au lieu d'une 1/2 journée avec du word bidouillé à la main à chaque fois en ce moment)
Alors 2 mn de plus... Ne soyons pas plus royaliste que le roi...
Merci à tous

[Pierre Fauconnier]

Salut.

Mon grain de sel…

Avant de vouloir faire du tout en un avec un code non maîtrisé par le demandeur (et éviter ainsi une laborieuse adaptation à son cas), il serait peut-être déjà judicieux d'inhiber le calcul et le rafraîchissement d'écran avant la suppression.

Code :

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

1
2
3
4
5
6
7
8
9
10
 
  Dim CalculationMode As XlCalculation
 
  CalculationMode = Application.Calculation
  Application.ScreenUpdating = False
 
  ' Ici, la boucle de suppression
 
  Application.Calculation = CalculationMode
  application.ScreenUpdating=true

Idéalement, on encadre cela dans une gestion d'erreur

[patricktoulon]

Bonjour
oui Pierre aussi
je me suis seulement attaqué a demultiplier les supressions a les ramener donc a une seule suppression (shapes/cells)
rien empleche effectivement les screenupdating=false les calculate a false et tout le toin toin

une version un peu plus precise +gestion de la non occurence dans un if

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
19
20
21
22
23
24
25
26
27
Sub test()
    Dim i&, a&, tabloshap(), tabshapesauvée(), rng As Range, calculateMode
    Application.ScreenUpdating = False
    calculateMode = Application.Calculation 
    Application.Calculation = xlCalculationManual
    For Each shap In ActiveSheet.Shapes
        If ActiveSheet.Cells(shap.TopLeftCell.Row, 7).Value = "X" Then
            i = i + 1: ReDim Preserve tabloshap(1 To i): tabloshap(i) = shap.Name
            If rng Is Nothing Then Set rng = shap.TopLeftCell Else Set rng = Union(rng, shap.TopLeftCell)
        Else
            a = a + 1: ReDim Preserve tabshapesauvée(1 To a): tabshapesauvée(a) = shap.Name & ":" & shap.Top
        End If
    Next
    If UBound(tabloshap) > 0 Then
        ActiveSheet.Shapes.Range(tabloshap).Group.Name = "toto"
        ActiveSheet.Shapes("toto").Delete
        rng.EntireRow.Delete
        '************************************************************************************************
        'IMPORTANT!!!!! si LA  correspondence shape/ligne n'est pas a prendre en compte dans le contexte
        ' on remet a leur place les shapes restantes qui ont forcement été decalées
        For i = 1 To UBound(tabshapesauvée)
            ActiveSheet.Shapes(Split(tabshapesauvée(i), ":")(0)).Top = Split(tabshapesauvée(i), ":")(1)
        Next
        '*************************************************************************************************
    End If
    Application.Calculation = calculateMode
End Sub

[retraite83]

merci à tous,
je regarderai cela tranquillement à mon retour de vacances, bon mois d'aout à tous

[NVCfrm]

Juste, il est vrai que les perfomances des manips sur l'interface ou via code dépendent toujours de la méthode e,ployée.

Selectionner les donnée de la colonne cible SHIFT + DOWN ou clic sur l'en tête de la lettre de colonne, clic sur outil filtre, clic sur la fléchette pour dérouler, filtre textuel est égal à x et hop, selection du resultat filtré et CTRL + - .
Selectionner une cellule contenant le critère, clic droit, filtrer, combinaison CTRL plus - et hop.

la réalisation ne prendra pas le temps de lecture de la description de la méthode, je crois.

[Pierre Fauconnier]

Ca va devenir une discussion d'experts à la fin de laquelle personne n'aura convaincu personne.

Si les données source sont dans une table de données, il faudra la renommer. Si la feuille a un codename utilisé dans du code, il faudra lui réattribuer...

Et si des formules pointent vers la feuille que vous supprimez, vous faites quoi? Parce qu'un RECHERCHEV, par exemple, qui pointerait vers une table créée sur cette feuille se prendrait un beau petit #REF!, non?

Je veux bien, à la rigueur, envisager un export, une vidange de la table et un réimport (avec des tables de données, pas des plages simples), mais une suppression de la feuille, j'attends de voir les dégâts collatéraux...

Ca ne me paraît donc pas très réaliste de supprimer la feuille après l'export et de simplement renommer la nouvelle feuille comme l'ancienne... Mais bon, je veux bien vous croire quand vous dites que vous faites cela tous les jours...

[joe.levrai]

Tu as raison, tout dépend du contexte, du projet, des dépendances, des liaisons.

Au moins on a encore une fois le mérite de présenter des pistes diverses et variées

[Invité]

sur une page de A1:V1048576

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
19
Sub test()t = Time
With ThisWorkbook
    .Sheets(2).Range("A1") = "cham1": .Sheets(2).Range("A2") = "<>x"
FiltreActif .Sheets(1).UsedRange, .Sheets(2).UsedRange, .Sheets(3).Range("A1"), False
n = .Sheets(1).Name: Application.DisplayAlerts = False: .Sheets(1).Delete: .Sheets(2).Name = n
End With
Debug.Print (Time - t) / 100
End Sub
Private Function FiltreActif(RangeSource As Range, CriterRange As Range, CopyRange As Range, Optional Unique As Boolean = True) As Boolean
FiltreActif = False
On Error Resume Next
 RangeSource.AdvancedFilter Action:= _
        xlFilterCopy, CriteriaRange:=CriterRange _
        , CopyToRange:=CopyRange, Unique:=Unique
        DoEvents
        If Err = 0 Then FiltreActif = True
        'MsgBox Err.Description
        On Error GoTo 0
End Function

[retraite83]

Et si un jour je dois modifier cela ?

je vais mettre plus de 2mn...
Je laisse cette solution aux experts
merci quand même

[Invité]

sur une page de A1:V1048576

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
19
Sub test()t = Time
With ThisWorkbook
    .Sheets(2).Range("A1") = "cham1": .Sheets(2).Range("A2") = "<>x"
FiltreActif .Sheets(1).UsedRange, .Sheets(2).UsedRange, .Sheets(3).Range("A1"), False
n = .Sheets(1).Name: Application.DisplayAlerts = False: .Sheets(1).Delete: .Sheets(2).Name = n
End With
Debug.Print (Time - t) / 100
End Sub
Private Function FiltreActif(RangeSource As Range, CriterRange As Range, CopyRange As Range, Optional Unique As Boolean = True) As Boolean
FiltreActif = False
On Error Resume Next
 RangeSource.AdvancedFilter Action:= _
        xlFilterCopy, CriteriaRange:=CriterRange _
        , CopyToRange:=CopyRange, Unique:=Unique
        DoEvents
        If Err = 0 Then FiltreActif = True
        'MsgBox Err.Description
        On Error GoTo 0
End Function

comme dab pas de justification du
-1, perso j'en mets jamais!

[GESCOM2000]

Bonjour

Moi je mettrais tout dans a tab() puis traitement en boucle et après un apllication.transpose....

[Pierre Fauconnier]

comme dab pas de justification du
-1, perso j'en mets jamais!

Bah. Je m'en suis pris un sur chaque message de la discussion, alors que j'ai chaque fois justifié mes dires. Ne t'arrête pas à ça

Cela étant, il faut reconnaître que la solution que tu proposes pose des problèmes, et j'en ai soulevé un tout à l'heure, en mentionnant les conséquences fâcheuses de la suppression d'une feuille. J'y ajouterai qu'elle ne fonctionnera que si une deuxième feuille de calcul est présente, car tu utilises sheets(2). Il faut donc qu'il y ait une deuxième feuille ET que ce soit une feuille de calcul. Si pas de deuxième feuille ou que c'est une feuille de graphique, le code plantera... Tu as le même problème avec Sheets(3).

Comme autre conséquence, si sheets(2) et sheets(3) existent, voilà que tu massacres ce qui se trouve dessus pour mettre ta plage de critère et ta place de copie.

Et tu proposes tout cela à un débutant sans le mettre le garde. A ta place, je ne serais pas étonné de recevoir un -1... Tu en mérites 10 sur ce coup-là (et ce n'est pas une attaque personnelle, crois-le bien, c'est une simple constatation technique des dangers d'une solution que je persiste à considérer comme non professionnelle)

[NVCfrm]

Bah. Je m'en suis pris un sur chaque message de la discussion, alors que j'ai chaque fois justifié mes dires. Ne t'arrête pas à ça

Vos remarques m'ont mis la puce à l'oreille. Il y a effectivement un participant silencieux qui a voté sur presque tous les posts.

Ce qui à mon humble avis n'a pas de sens.

[retraite83]

Je ré-ouvre cette discussion après avoir lu le document "Formation Excel- VBA débutant" (EXCELLENT ! écrit par l'un de vous je crois)
A l'époque je n'avais rien compris à ce document, maintenant il m'éclaire parfaitement

J'ai été attiré par l'article en bas de la page 179


Je tente de voir comment améliorer une macro qui supprime les lignes ayant en "X" en colonne 40 pour finaliser une mise en page, voici le code qui tourne parfaitement mais assez long (j'ai plusieurs macros qui font ce type de mise en page)

Code :

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

1
2
3
4
5
6
7
8
9
 
For i = derligPdf To 1 Step -1
If Cells(i, 40).Value = "X" Then
    For Each shap In ActiveSheet.Shapes
    If shap.TopLeftCell.Row = i Then shap.Delete
    Next
Cells(i, 40).EntireRow.Delete
End If
Next i

Dans un premier temps si quelqu'un peut me dire si le code du cours (incompréhensible pour moi pour le moment) peut être adapté pour remplacer ma macro.

le faire sera une autre histoire

[halaster08]

Je tente de voir comment améliorer une macro qui supprime les lignes ayant en "X" en colonne 40 pour finaliser une mise en page, voici le code qui tourne parfaitement mais assez long (j'ai plusieurs macros qui font ce type de mise en page)

Dans un premier temps si quelqu'un peut me dire si le code du cours (incompréhensible pour moi pour le moment) peut être adapté pour remplacer ma macro.

Tu cherches a supprimer des choses (lignes + shape) alors que la macro de ton cours sert a faire un copier coller (c'est écrit dans le texte), donc non je pense que tu ne regardes pas au bon endroit.

Code :

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

1
2
3
4
5
6
7
8
9
 
For i = derligPdf To 1 Step -1
If Cells(i, 40).Value = "X" Then
    For Each shap In ActiveSheet.Shapes
    If shap.TopLeftCell.Row = i Then shap.Delete
    Next
Cells(i, 40).EntireRow.Delete
End If
Next i

Ce qui est long, c'est que pour chaque ligne X tu boucles sur toutes les shapes
Voici ce que je ferais, une seule boucle sur les shapes

Code :

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

1
2
3
For Each shap In ActiveSheet.Shapes
    If cells(shap.TopLeftCell.Row,40).value = "X" Then shap.Delete
    Next

Puis un filtre sur la colonne 40 avec la valeur X pour supprimer toutes les lignes d'un coup

[retraite83]

merci je vais voir cela,

qu'entends tu par un filtre sur la colonne 40?

[halaster08]

qu'entends tu par un filtre sur la colonne 40?

Pour le filtre, voir l'aide: https://support.office.com/fr-fr/art...6-38c37dcc180e
Pour la colonne 40, c'est dans ton code If Cells(i, 40).Value = "X" ThenUne fois les données filtrées tu peux faire la suppression sans boucle, ce qui est bien plus rapide (un des membres du forum a mis un tuto la dessus dans la sous-section contribuez: https://www.developpez.net/forums/d1...on-lignes-vba/)

[Pierre Fauconnier]

NVCfrm,

Je suis d'accord que la manip sur filtre automatique sera plus rapide, mais elle ne s'intègre pas dans un processus VBA global. J'imagine mal, lors d'un traitement global, le code s'arrêter et envoyer un popup "Merci de supprimer à la main puis de lancer la suite du code"...

Donc parfois, même si la solution paraît très simple et rapide via l'interface Excel, la demande globale impose qu'on la fasse en VBA. Et dans ce cas, il y a des solutions moins catastrophiques qu'un filtre avancé avec export et suppression de la feuille qui ne me semble pas du tout réaliste. Par contre, singer en VBA les manips dont tu parles au niveau Excel me semble être une piste intéressante si le besoin existe d'optimiser

[NVCfrm]

NVCfrm,

Je suis d'accord que la manip sur filtre automatique sera plus rapide, mais elle ne s'intègre pas dans un processus VBA global. J'imagine mal, lors d'un traitement global, le code s'arrêter et envoyer un popup "Merci de supprimer à la main puis de lancer la suite du code"...

Donc parfois, même si la solution paraît très simple et rapide via l'interface Excel, la demande globale impose qu'on la fasse en VBA. Et dans ce cas, il y a des solutions moins catastrophiques qu'un filtre avancé avec export et suppression de la feuille qui ne me semble pas du tout réaliste. Par contre, singer en VBA les manips dont tu parles au niveau Excel me semble être une piste intéressante si le besoin existe d'optimiser

Bah à chaque champ de bataille ses propres moyens de combat. Sur le terrain VBA j'imagine qu'une ligne de code, au plus deux suffiront.