probleme de macro tres long pour supresion sur plusieur feuille

C

creolia

XLDnaute Impliqué
bonsoir je viens vers vous car j'ai un probleme lier a mon button suprimer

ROLAND M ma gentillement fais une macro me permetant la supression de mes lignes

Code: 
Private Sub ButtonSuppNom_Click()
Dim Idx&, NoLigBase&, NoOrdre&
If ComboBoxBase = "" Then Exit Sub
Idx = ComboBoxBase.ListIndex
    
Reponse = MsgBox("Confirmez la  suppression de " & ComboBoxBase.List(Idx, 0) & " ?", vbQuestion + vbYesNo, "Suppression")
If Reponse <> vbYes Then Exit Sub
    
NoLigBase = ComboBoxBase.List(Idx, 3)
NoOrdre = Val(TextBoxNoOrdre.Value)
    
'delete le nom dans base col A à D
Sheets(NomDeLaFeuilBase).Range("A" & NoLigBase & ":D" & NoLigBase).Delete Shift:=xlUp
'delete le nom dans feuille formation Col A à I
For Index1 = 1 To ListView1.ListItems.Count
    NomDeLaFeuilFormation = ListView1.ListItems(Index1).ListSubItems(6).Text
    With Sheets(NomDeLaFeuilFormation)
        For Each Cellule In .Range("A5:A" & .Range("A65536").End(xlUp).Row)
            If Val(Cellule.Value) = NoOrdre Then
               .Range("A" & Cellule.Row & ":I" & Cellule.Row).Delete Shift:=xlUp
               Exit For
            End If
        Next Cellule
    End With
Next Index1

ComboBoxBase = ""
RemplirComboxBase
CreatListView1
InitLesTextBox 0
End Sub


le soucis c'est que à la base il à été tester sur un classeur de quelques onglet sauf que j'en ai 71 et la sa va plus du tout


quelqu'un pourais t'il m'aider à resoudree ce probleme svp merci pour tout l'aide que vous m'apporterais


bonne soirée

comme le fichier est lourd je l'ai mis en lien sur cijoint

Cijoint.fr - Service gratuit de dépôt de fichiers

merci
 
Trier par date Trier par votes
C

Compte Supprimé 979

Guest
Re : probleme de macro tres long pour supresion sur plusieur feuille

Salut Creolia,

Tu peux essayer ce code
Code: 
Private Sub ButtonSuppNom_Click()
  Dim Idx&, NoLigBase&, NoOrdre&, Lig As Long
  If ComboBoxBase = "" Then Exit Sub
  Idx = ComboBoxBase.ListIndex

  Reponse = MsgBox("Confirmez la  suppression de " & ComboBoxBase.List(Idx, 0) & " ?", vbQuestion + vbYesNo, "Suppression")
  If Reponse <> vbYes Then Exit Sub

  NoLigBase = ComboBoxBase.List(Idx, 3)
  NoOrdre = Val(TextBoxNoOrdre.Value)

  'delete le nom dans base col A à D
  Sheets(NomDeLaFeuilBase).Range("A" & NoLigBase & ":D" & NoLigBase).Delete Shift:=xlUp
  'delete le nom dans feuille formation Col A à I
  For Index1 = 1 To ListView1.ListItems.Count
    NomDeLaFeuilFormation = ListView1.ListItems(Index1).ListSubItems(6).Text
    With Sheets(NomDeLaFeuilFormation)
      On Error Resume Next
      Do
        Lig = 0  ' Mettre à zéro le numéro de ligne pour les recherches suivantes
        Lig = .Range("A:A").Find(What:=NoOrdre, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                 MatchCase:=False, SearchFormat:=False).Row
        If Lig > 4 Then .Rows(Lig).Delete Shift:=xlUp: Lig = 0 Else Exit Do
      Loop
    End With
  Next Index1

  ComboBoxBase = ""
  RemplirComboxBase
  CreatListView1
  InitLesTextBox 0
End Sub
Plutôt que de parcourir toutes les lignes jusqu'à la fin,
on effectue une recherche du "Numéro d'ordre"
Si trouvé, on supprime la ligne et on effectue une autre recherche Do ... Loop
Sinon, on sort de la boucle

A+
 
Vote positif 0 Vote négatif
Roland_M

Roland_M

XLDnaute Barbatruc
Re : probleme de macro tres long pour supresion sur plusieur feuille

bonsoir

essais déjà de mettre au début sub
après ceci !
If Reponse <> vbYes Then Exit Sub

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

et à la fin tu remets
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

pour le nom de tes feuilles de formation tu aurais pu faire plus simple
quand on a une telle quantité on simplifie le nom au plus court !
exemple F1 F2 F3 F4 F. . . . .

EDIT :
salut BrunoM45 ! on s'est croisé.

Creolia ci-joint la modif apporté par BrunoM45 qui sera effectivement plus rapide et en rajoutant ce que je t'ai mis ci-dessus

Code: 
Private Sub ButtonSuppNom_Click()
  Dim Idx&, NoLigBase&, NoOrdre&, Lig As Long
  If ComboBoxBase = "" Then Exit Sub
  Idx = ComboBoxBase.ListIndex

  Reponse = MsgBox("Confirmez la  suppression de " & ComboBoxBase.List(Idx, 0) & " ?", vbQuestion + vbYesNo, "Suppression")
  If Reponse <> vbYes Then Exit Sub

  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Application.EnableEvents = False

  NoLigBase = ComboBoxBase.List(Idx, 3)
  NoOrdre = Val(TextBoxNoOrdre.Value)

  'delete le nom dans base col A à D
  Sheets(NomDeLaFeuilBase).Range("A" & NoLigBase & ":D" & NoLigBase).Delete Shift:=xlUp
  'delete le nom dans feuille formation Col A à I
  On Error Resume Next
  For Index1 = 1 To ListView1.ListItems.Count
    NomDeLaFeuilFormation = ListView1.ListItems(Index1).ListSubItems(6).Text
    With Sheets(NomDeLaFeuilFormation)
      Do
        Lig = 0  ' Mettre à zéro le numéro de ligne pour les recherches suivantes
        Lig = .Range("A:A").Find(What:=NoOrdre, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                            MatchCase:=False, SearchFormat:=False).Row
        If Lig > 4 Then .Rows(Lig).Delete Shift:=xlUp: Lig = 0 Else Exit Do
      Loop
    End With
  Next Index1

  ComboBoxBase = ""
  RemplirComboxBase
  CreatListView1
  InitLesTextBox 0
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
  Application.EnableEvents = True
  On Error GoTo 0: Err.Clear
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
C

creolia

XLDnaute Impliqué
Re : probleme de macro tres long pour supresion sur plusieur feuille

re bonsoir j'ai donc tester c'est vraiment tres rapide mais il m'oublie des ligne sur certaine feuille

bon je vous embête pas plus je vais me pencher voir si j y arrive seul a résoudre ceci merci encore a tous les deux bonne soirée
 
Vote positif 0 Vote négatif
Roland_M

Roland_M

XLDnaute Barbatruc
Re : probleme de macro tres long pour supresion sur plusieur feuille

re

c'est pour cela que j'avais bouclé !
car avec find j'ai déjà eu tellement de surprises !
je m'en sert juste comme test de présence et si oui je boucle !
mais c'est vrai que c'est beaucoup plus rapide !

je vais y regarder !
 
Dernière édition:
Vote positif 0 Vote négatif
Roland_M

Roland_M

XLDnaute Barbatruc
Re : probleme de macro tres long pour supresion sur plusieur feuille

re

voilà la modif !

j'ai quand même réussi tout en gardant Find !
tu fais des essais et tu dis quoi !
sinon il faudra remettre la boucle !

Code: 
Private Sub ButtonSuppNom_Click()
  Dim Idx&, NoLigBase&, NoOrdre&, Rang As Range
  If ComboBoxBase = "" Then Exit Sub
  Idx = ComboBoxBase.ListIndex

  Reponse = MsgBox("Confirmez la  suppression de " & ComboBoxBase.List(Idx, 0) & " ?", vbQuestion + vbYesNo, "Suppression")
  If Reponse <> vbYes Then Exit Sub

  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Application.EnableEvents = False

  NoLigBase = ComboBoxBase.List(Idx, 3)
  NoOrdre = Val(TextBoxNoOrdre.Value)

  'delete le nom dans base col A à D
  Sheets(NomDeLaFeuilBase).Range("A" & NoLigBase & ":D" & NoLigBase).Delete Shift:=xlUp
  'delete le nom dans feuille formation Col A à I
  On Error Resume Next
  For Index1 = 1 To ListView1.ListItems.Count
    NomDeLaFeuilFormation = ListView1.ListItems(Index1).ListSubItems(6).Text
    With Sheets(NomDeLaFeuilFormation)
    Do
     Set Rang = .Columns(1).Find(NoOrdre, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, SearchOrder:=xlByRows, SearchDirection:=xlNext)
     If Not Rang Is Nothing Then
        If Rang.Row > 4 Then .Rows(Rang.Row).Delete Shift:=xlUp Else Exit Do
     Else
        Exit Do
     End If
    Loop
    End With
  Next

  ComboBoxBase = ""
  RemplirComboxBase
  CreatListView1
  InitLesTextBox 0
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
  Application.EnableEvents = True
  On Error GoTo 0: Err.Clear
End Sub
 
Vote positif 0 Vote négatif
C

creolia

XLDnaute Impliqué
Re : probleme de macro tres long pour supresion sur plusieur feuille

bonjour Roland_M

j'ai donc essayer avec ta dernière solution et c'est pareil dans les deux cas j'ai noter qu'il supprimais mais uniquement de la formation2 à la formation4 tous le reste n'est pas fais sa viens peut être de là bon je regarde tout cela et je te dit quoi
 
Vote positif 0 Vote négatif
C

creolia

XLDnaute Impliqué
Re : probleme de macro tres long pour supresion sur plusieur feuille

Re dsl j'ai ressayer compris pourquoi sa marchais pas c'est tous bête dans la l'onglet base sa s'arrêtait à formation4

la sa fonctionne merci pour votre aide

à bientot
 
Vote positif 0 Vote négatif

Discussions similaires

hemardjean
  • Question
Affichage ListItems décalé de 7 lignes
Réponses
0
Affichages
6 K
hemardjean
hemardjean
F
  • Question
Aide rédaction macro création de feuille sur la base d'un modèle
Réponses
2
Affichages
2 K
fb62840
F
C
  • Question
macro de recherche listbox transformer pour une listeview
Réponses
1
Affichages
773
cpeens
C
S
  • Question
Macro probleme...Activation Module de Feuille alors que absolument pas concerne......
Réponses
7
Affichages
2 K
sim
S

Membres actuellement en ligne

1 membres et 29 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 645
Messages
2 111 536
Membres
111 183
dernier inscrit
angelique76120