probleme de macro tres long pour supresion sur plusieur feuille

creolia · 17 Mars 2010

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

Compte Supprimé 979 · 17 Mars 2010

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+

Roland_M · 17 Mars 2010

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

creolia · 18 Mars 2010

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

bonsoir a tous les deux et merci je teste de suite

bonne soirée

creolia · 18 Mars 2010

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

Roland_M · 18 Mars 2010

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 !

Roland_M · 18 Mars 2010

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

creolia · 19 Mars 2010

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

creolia · 19 Mars 2010

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

Habitude · 19 Mars 2010

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

XlUp
Partir d'en bas et monté. Si quelques éléments, ca risque d'être long.

Pour ne pas partir d'en haut est descendre avec xldown?

creolia · 26 Mars 2010

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

Re solution resolu il s'agissais d'une macro qui me ralentissais le tout merci pour votre aide

probleme de macro tres long pour supresion sur plusieur feuille

creolia

XLDnaute Impliqué

Compte Supprimé 979

Guest

Roland_M

XLDnaute Barbatruc

creolia

XLDnaute Impliqué

creolia

XLDnaute Impliqué

Roland_M

XLDnaute Barbatruc

Roland_M

XLDnaute Barbatruc

creolia

XLDnaute Impliqué

creolia

XLDnaute Impliqué

Habitude

XLDnaute Accro

creolia

XLDnaute Impliqué

Discussions similaires

probleme de macro tres long pour supresion sur plusieur feuille

XLDnaute Impliqué

Compte Supprimé 979

Guest

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Impliqué

XLDnaute Impliqué

XLDnaute Accro

XLDnaute Impliqué

Discussions similaires

Privacy & Transparency

Privacy & Transparency