Souci à la création d'une macro - fonction recherche et supprimer lignes

Bonjour à tous,

Je viens une nouvelle fois requérir votre aide.

Je souhaite créer une macro pour automatiser la mise en forme d'un fichier. A la base ma macro était longue et ne fonctionnait pas, je l'ai donc raccourcie pour comprendre d'où venait le problème mais je n'arrive pas à le résoudre.

Le problème de ma macro se produit au tout début de ma "séquence" lorsque je sélectionne une colonne, choisi la fonction recherche pour sélectionner les cellules qui contiennent "annulé"(3ème onglet de mon fichier, colonne J), puis je demande de supprimer les lignes contenant ces cellules. En manipulation simple ça fonctionne mais lorsque je lance ma macro toutes les données de ma feuille s'effacent et je ne comprend pas pourquoi. J'ai fait de nombreux essais, et ça fait 3 jours que je suis dessus sans résultat.

J'ai essayé en utilisant les références relatives ou non et le résultat est le même.

Pourriez-vous m'aider à comprendre où je fais erreur? Ou est ce que cette manipulation ne fonctionnerait pas en macro? Je suppose qu'en VBA c'est faisable mais je n'y connais rien du tout en VBA. Si j'arrive à comprendre là où je fais erreur je pense pouvoir arriver à faire toutes les autres manipulations de mon fichier final car c'est la même opération que je dois réaliser une dizaine de fois pour arriver au résultat que je recherche.

Merci d'avance pour votre aide et excellente journée à tous.

Lorence

Bonjour,

Il n'y a aucune macro dans ce classeur.

Il n'y a aucun "annulé" (3ème onglet, colonne J) dans cette feuille...

Donc j'ai fait une macro qui supprime tous les "validé"

Sub Test()
Dim Arr, i&
Application.ScreenUpdating = False
Arr = [A1].CurrentRegion.Value
For i = UBound(Arr) To 2 Step -1
   If Arr(i, 10) = "validé" Then Rows(i).Delete
Next
End Sub

A+

Heu.... ça c'est étrange car moi j'en ai... j'ai téléchargé le fichier pour vérifier et j'ai bien des annulés en colonne J de l'onglet "TE à encoder" et la macro s'appelle "bbb"

La macro ne s'afficherait que chez moi ? Pourtant je l'ai bien enregistrée dans le classeur

Bonjour,

Un test

Ca fonctionne ;) Merci !

Du coup qu'est ce que j'avais mal fait en créer la macro? Ou je dois d'office passer par du VBA?

Je vais essayer de créer mon fichier avec les autres manipulations en me basant sur ce code

Est ce que je dois créer un module pour chaque suppression ou je mets les lignes les unes en dessous des autres?

Par exemple, dans la même colonne je dois aussi supprimer les lignes dont la cellule J contient "enregistré", est ce que je crée un nouveau module avec le code adapté

Sub Suppr()
Dim dl%, i%, Ws As Worksheet
Application.ScreenUpdating = False
Set Ws = Worksheets("TE à encoder - EVERE (2)")
dl = Ws.Range("A" & Rows.Count).End(xlUp).Row
For i = dl To 2 Step -1
If Ws.Range("J" & i) = "enregistré" Then Rows(i).EntireRow.Delete
Next i

End Sub

Ou j'insère quelque chose dans le module que tu as fait?

Re,

Vu qu'il y a un grand nombre d'enregistré, une autre macro plus rapide

Oui je n'avais pas vu car il y avait vraiment très peu de "annulé" et comme vous n'avez pas parlé de filtre ça ne m'est pas nu à l'idée de chercher comme ça...

Bah... Vous pouvez toujours continuer comme vous faites : je trouve pas ça très pratique mébon... Du moment que ça fonctionne !

Il y a des tas de solutions... Tout dépend de ce que vous avez vraiment à faire : Si vous devez faire ces suppressions séparément ou a différents moments ou au contraire tout en même temps.

La macro de M12 travaille directement sur la feuille et la mienne sur un Array cette solution est censée être plus rapide... Mais à part ça la meilleure méthode est celle qui vous semble la plus commode !

Si vous voulez faire plusieurs suppressions en même temps sur la base de la macro que je vous ai proposé vous pouvez faire :

Sub Test()
Dim Arr, i&
Application.ScreenUpdating = False
Arr = [A1].CurrentRegion.Value
For i = UBound(Arr) To 2 Step -1
   If Arr(i, 10) = "annulé" Or Arr(i, 10) = "sans chèques" Then Rows(i).Delete
Next
End Sub

... et même rajouter autant de

or Arr(i, 10) = "blabla"

...qu'il est nécessaire...

A+

J'avance, j'avance

Voici ce que j'ai pour l'instant

Sub essai25juin()
'
' essai25juin Macro
'

'

Dim dl%, i%, Ws As Worksheet
Application.ScreenUpdating = False
Set Ws = Worksheets("VUE D'ENSEMBLE")
dl = Ws.Range("A" & Rows.Count).End(xlUp).Row
For i = dl To 2 Step -1
If Ws.Range("I" & i) = "annulé" Then Rows(i).EntireRow.Delete
Next i

Set Ws = Worksheets("VUE D'ENSEMBLE")
dl = Ws.Range("A" & Rows.Count).End(xlUp).Row
For i = dl To 2 Step -1
If Ws.Range("K" & i) = "à chercher" Then Rows(i).EntireRow.Delete
Next i

Set Ws = Worksheets("RAPPORT")
dl = Ws.Range("A" & Rows.Count).End(xlUp).Row
For i = dl To 2 Step -1
If Ws.Range("K" & i) = "0" Then Rows(i).EntireRow.Delete
Next i

Set Ws = Worksheets("RAPPORT")
dl = Ws.Range("A" & Rows.Count).End(xlUp).Row
For i = dl To 2 Step -1
If Ws.Range("I" & i) = "chèques attribués" Then Rows(i).EntireRow.Delete
Next i

Set Ws = Worksheets("RAPPORT")
dl = Ws.Range("A" & Rows.Count).End(xlUp).Row
For i = dl To 2 Step -1
If Ws.Range("I" & i) = "Titres-services partiellement attribués" Then Rows(i).EntireRow.Delete
Next i

Set Ws = Worksheets("RAPPORT")
dl = Ws.Range("A" & Rows.Count).End(xlUp).Row
For i = dl To 2 Step -1
If Ws.Range("I" & i) = "confirmée par le client" Then Rows(i).EntireRow.Delete
Next i

Set Ws = Worksheets("RAPPORT")
dl = Ws.Range("A" & Rows.Count).End(xlUp).Row
For i = dl To 2 Step -1
If Ws.Range("I" & i) = "Partiellement remboursée" Then Rows(i).EntireRow.Delete
Next i

End Sub

Ca fonctionne mais c'est vrai que ça prend du temps, puis je l'écrire différement?

Galopin je ne parviens pas à ré-utiliser ton code dans mon fichier, pourtant sur le tien ça fonctionne, il me semble qu'il ne trouve pas l'onglet sur lequel travailler, comment puis je faire parce que là je ne comprend pas du tout le code ;)

Enfin, pour finaliser la chose, j'aurais besoin de trier mes colonnes en ordre croissant, d'abord la D, puis le H, puis le B, sur deux feuilles différentes "VUE D'ENSEMBLE" et "RAPPORT"

J'ai essayé ceci mais ça ne fonctionne pas

Set Ws = Worksheets("RAPPORT")
dl = Ws.Range("A" & Rows.Count).End(xlUp).Row
Range("B2:H3500").Sort Range("D2"), xlAscending, Range("H2"), , xlAscending, Range("B2"), , xlAscending

Merci beaucoup pour votre aide bien précieuse pour les amateurs comme moi ;)

voici un des fichiers

Re,

A tester

ha oui ça fonctionne bien sur les suppression

Comment je m'y prends pour réunir les deux en 1 seul bouton? J'ai essayé en supprimant juste la ligne et le titre de la seconde macro mais ça ne fonctionne pas, je dois ajouter quelque chose je suppose, un "Next"?

Par contre le tri ne fonctionne pas mais je pense que c'est dans le code car je vois colonne L mais ce sont les colonnes D, puis H puis B que je dois trier par ordre croissant (sur les deux feuilles). J'ai essayé de changer les L en B pour voir si ça fonctionnait mais non, donc c'est pas ça que je dois changer

Sub supLignesRapport()
Application.ScreenUpdating = False
dl = Range("A" & Rows.Count).End(xlUp).Row
a = Range("I2:I" & dl)
For i = LBound(a) To UBound(a)
If a(i, 1) = "chèques attribués" Or a(i, 1) = "Titres-services partiellement attribués" Or a(i, 1) = "confirmée par le client" Or a(i, 1) = "0" Or a(i, 1) = "Partiellement remboursée" Then
a(i, 1) = "sup"
Else
a(i, 1) = 0
End If
Next i
Columns("B:B").Insert Shift:=xlToRight
[B2].Resize(UBound(a)) = a
[B2].CurrentRegion.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlYes
On Error Resume Next
Range("B2:B" & dl).SpecialCells(xlCellTypeConstants, 6).EntireRow.Delete
Columns("B:B").Delete Shift:=xlToLeft

Application.ScreenUpdating = False
dl = Range("B" & Rows.Count).End(xlUp).Row
a = Range("I2:I" & dl)
For i = LBound(a) To UBound(a)
If a(i, 1) = "à chercher" Or a(i, 1) = "annulé" Or a(i, 1) = "0" Then
a(i, 1) = "sup"
Else
a(i, 1) = 0
End If
Next i
Columns("B:B").Insert Shift:=xlToRight
[B2].Resize(UBound(a)) = a
[B2].CurrentRegion.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlYes
On Error Resume Next
Range("B2:B" & dl).SpecialCells(xlCellTypeConstants, 6).EntireRow.Delete
Columns("B:B").Delete Shift:=xlToLeft
End Sub

Je suis parvenue à réunir les deux sub en créant un bouton qui fait appel aux deux à la suite l'une de l'autre

Il me reste le souci de tri que je ne parviens pas à résoudre

Bon sang j'en peux plus !

30 heures que je bosse sur ce fichier et je n'arrive à rien... damned !

Je pensais avoir réussi à réunir les deux macros en 1 bouton mais non (je l'ai mis dans la première feuille)

De plus mes ajouts de lignes à supprimer ne fonctionnent pas toutes,

If a(i, 1) = "chèques attribués" Or a(i, 1) = "Titres-services partiellement attribués" Or a(i, 1) = "0" Or a(i, 1) = "confirmée par le client" Or a(i, 1) = "Partiellement remboursée" Then

et je ne parviens pas à comprendre pourquoi....

et mon souci de tri qui ne marche pas...

Purée 30 heures pour arriver à rien.... j'ai juste envie de pleurer m**** alors

Re,

Teste cela fonctionnera

Dans l'onglet RAPPORT, il ne faut pas prendre la colonne A qui est vide, mais la B ou autres

Bonjour,

Merci beaucoup !

J'ai encore re-travaillé dessus et il me reste 2 choses à solutionner.

La première ce sont les lignes vides des 2 derniers onglets qui restent après l'exécution des modules et que je ne sais pas comment supprimer (du coup lorsque le tri s'effectue ce sont les lignes vides qui apparaissent en premier, mais je dois imprimer ces deux rapports)

La seconde c'est ma tentative de réunir toutes les macros en 1 seul bouton mais qui ne fonctionne pas, quand je le lance j'ai tout de même les lignes qui devraient se supprimer qui restent. Pour l'instant je fais convertir dans le premier onglet puis Tri 1 et Tri 2 dans les deux derniers onglets "vue d'ensemble" et "rapport", ça serait encore mieux de n'avoir qu'un bouton à cliquer pour que tout se fasse en une fois, je ne comprend pas mon erreur sur ce point.

Un énorme merci pour votre aide. Cela fait 10 ans que je suis sur Excel, et j'en suis fan, par contre je débute en VBA (première fois, mais je vois bien que ça peut m'ouvrir plein d'autres possibilités donc j'aimerais approfondir, je me suis d'ailleurs commandé un bouquin pour apprendre)

zut je n'arrive pas à l'importer, il est trop lourd....

Voici ce que j'ai mis pour le bouton qui réunit les macros :

Sub Button1_Click()

Call convertir
Call supLignesVueEnsemble
Call supLignesRapport
Call Trivueensemble
Call Trirapport

End Sub

Et voici mon module pour la suppression des lignes, que puis je ajouter pour que les lignes vides se suppriment (mais il y a des formules dedans)

Sub supLignesRapport()
Application.ScreenUpdating = False
dl = Range("B" & Rows.Count).End(xlUp).Row
a = Range("I2:I" & dl)
For i = LBound(a) To UBound(a)
If a(i, 1) = "chèques attribués" Or a(i, 1) = "Titres-services partiellement attribués" Or a(i, 1) = "0" Or a(i, 1) = "annulé" Or a(i, 1) = "confirmée par le client" Or a(i, 1) = "Partiellement remboursée" Then
a(i, 1) = "sup"
Else
a(i, 1) = 0
End If
Next i
Columns("L:L").Insert Shift:=xlToRight
[L2].Resize(UBound(a)) = a
[L2].CurrentRegion.Sort key1:=Range("L2"), order1:=xlAscending, Header:=xlYes
On Error Resume Next
Range("L2:L" & dl).SpecialCells(xlCellTypeConstants, 6).EntireRow.Delete
Columns("L:L").Delete Shift:=xlToLeft
End Sub

Bonjour,

A l'avenir quand vous insérez du code (VBA) veuillez cliquer sur le bouton </> avant de coller votre code ce qui préserve la lisibilité.

A+

Je suis parvenue à résoudre mon souci de lignes à supprimer

Me reste mon bouton pour réunir les macros à la suite les unes des autres

J'ai essayé ceci mais il y a une erreur d'écriture, je continue de chercher

Sub Button1_Click()

Sub convertir()

Call supLignesVueEnsemble

End Sub

Sub supLignesVueEnsemble()

Call supLignesRapport

End Sub

Sub supLignesRapport()

Call Trivueensemble

End Sub

Sub Trivueensemble()

Call Trirapport

End Sub

Sub Trirapport()

End Sub

Bonjour,

Comme ceci

Sub Button1_Click()
Call supLignesVueEnsemble
Call supLignesRapport
Call Trivueensemble
Call Trirapport
End Sub

C'est ce que j'avais mis en premier lieu mais ça ne fonctionne pas, je ne comprends pas pourquoi.... d'après ce que je vois on dirait que 3 macros s'exécutent sur 5 : la première et les deux dernières, pourquoi?

Voici tous mes modules :

Sub supLignesRapport()
  Application.ScreenUpdating = False
  dl = Range("B" & Rows.Count).End(xlUp).Row
  a = Range("I2:I" & dl)
  For i = LBound(a) To UBound(a)
    If a(i, 1) = "chèques attribués" Or a(i, 1) = "Titres-services partiellement attribués" Or a(i, 1) = "0" Or a(i, 1) = "annulé" Or a(i, 1) = "confirmée par le client" Or a(i, 1) = "Partiellement remboursée" Then
      a(i, 1) = "sup"
      Else
      a(i, 1) = 0
    End If
  Next i
  Columns("L:L").Insert Shift:=xlToRight
  [L2].Resize(UBound(a)) = a
  [L2].CurrentRegion.Sort key1:=Range("L2"), order1:=xlAscending, Header:=xlYes
  On Error Resume Next
  Range("L2:L" & dl).SpecialCells(xlCellTypeConstants, 6).EntireRow.Delete
  Columns("L:L").Delete Shift:=xlToLeft
End Sub

Sub supLignesVueEnsemble()
  Application.ScreenUpdating = False
  dl = Range("B" & Rows.Count).End(xlUp).Row
  a = Range("I2:I" & dl)
  For i = LBound(a) To UBound(a)
    If a(i, 1) = "annulé" Or a(i, 1) = "0" Then
      a(i, 1) = "sup"
      Else
      a(i, 1) = 0
    End If
  Next i
  Columns("L:L").Insert Shift:=xlToRight
  [L2].Resize(UBound(a)) = a
  [L2].CurrentRegion.Sort key1:=Range("L2"), order1:=xlAscending, Header:=xlYes
  On Error Resume Next
  Range("L2:L" & dl).SpecialCells(xlCellTypeConstants, 6).EntireRow.Delete
  Columns("L:L").Delete Shift:=xlToLeft
End Sub

Sub Button1_Click()
    Call convertir
    Call supLignesVueEnsemble
    Call supLignesRapport
    Call Trivueensemble
    Call Trirapport
End Sub

Sub Trivueensemble()
'
' Trier les colonnes
'

'
    Columns("D:D").Select
    ActiveWorkbook.Worksheets("Vue d'ensemble").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Vue d'ensemble").Sort.SortFields.Add2 Key:=Range( _
        "D1:D6000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Vue d'ensemble").Sort
        .SetRange Range("A2:K6000")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Columns("H:H").Select
    ActiveWorkbook.Worksheets("Vue d'ensemble").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Vue d'ensemble").Sort.SortFields.Add2 Key:=Range( _
        "H1:H6000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Vue d'ensemble").Sort
        .SetRange Range("A2:K6000")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Columns("B:B").Select
    ActiveWorkbook.Worksheets("Vue d'ensemble").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Vue d'ensemble").Sort.SortFields.Add2 Key:=Range( _
        "B1:B881"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Vue d'ensemble").Sort
        .SetRange Range("A2:K6000")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Sub Trirapport()
'
' Trier les colonnes
'

'
    Columns("D:D").Select
    ActiveWorkbook.Worksheets("Rapport").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Rapport").Sort.SortFields.Add2 Key:=Range( _
        "D1:D6000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Rapport").Sort
        .SetRange Range("A2:K6000")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Columns("H:H").Select
    ActiveWorkbook.Worksheets("Rapport").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Rapport").Sort.SortFields.Add2 Key:=Range( _
        "H1:H6000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Rapport").Sort
        .SetRange Range("A2:K6000")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Columns("B:B").Select
    ActiveWorkbook.Worksheets("Rapport").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Rapport").Sort.SortFields.Add2 Key:=Range( _
        "B1:B881"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Rapport").Sort
        .SetRange Range("A2:K6000")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Sub convertir()
'
' convertir csv
'

'
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
        ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
        (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1)), TrailingMinusNumbers _
        :=True
End Sub

Le résultat est que c'est converti, c'est trié, mais les macro de suppression de lignes n'ont pas marché. Une idée?