Completer une macro enregistree - debutant

[urbanito1]

Bonjour à la communauté,

j'ai une petite macro enregistrée à laquelle je voudrais rajouter un petit complément.

deux fichiers en annex

le premier liste initiale
le second, ce que j'ai déjà fait et le complément souhaité

merci à vous

Urbanito1

 

[gilbert_RGI]

Re : Completer une macro enregistree - debutant

Bonjour

ajoutez cette macro à votre code

[Sub sup()
For i = 1 To Sheets("liste initiale").Range("F65536").End(xlUp).Row
If Cells(i, 6).Value = 200 Then Cells(i, 6).EntireRow.Delete: i = i - 1
Next
End Sub

 

[job75]

Re : Completer une macro enregistree - debutant

Bonjour urbanito1, salut Gilbert,

Voyez aussi cette macro dans le fichier joint :

Sub TraiterListe()
Dim supp, h&, tablo, i&, t$, v%, p%
supp = 200 'adapter la valeur à supprimer
Application.ScreenUpdating = False
h = Cells(Rows.Count, 1).End(xlUp).Row
[B:B].Insert 'insertion de 2 colonnes
[B:B].Insert
tablo = [A1:G1].Resize(h)
For i = 1 To UBound(tablo)
  t = tablo(i, 1)
  v = InStr(t, "(")
  If v Then tablo(i, 1) = Trim(Left(t, v - 1))
  p = InStr(t, ":")
  If p Then tablo(i, 2) = Val(Mid(t, p + 1))
  If tablo(i, 7) <> supp Then tablo(i, 3) = 1
Next
[A1:G1].Resize(h) = tablo 'restitution
'tri pour avoir les cellules vides en fin de liste (suppression plus rapide)
[A1].Resize(h, Columns.Count).Sort [C1]
On Error Resume Next 'si aucune cellule vide
[C:C].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
[C:C].Delete
[A1] = "Nom Prénom"
[B1] = "Matricule Agent"
Columns("A").AutoFit 'ajustement automatique
Columns("B").AutoFit
End Sub

Elle est est très rapide même sur de très grandes listes car :

- elle utilise un tableau VBA (tablo)

- les lignes à supprimer sont placées en fin de liste grâce à un tri.

A+

 

[job75]

Re : Completer une macro enregistree - debutant

Re,

Sur Excel 2010 (et fichier .xlsm) j'ai copié le tableau jusqu'à la ligne 105001.

Durée d'exécution de la macro précédente => 5,7 secondes.

A+

 

[urbanito1]

Re : Completer une macro enregistree - debutant

Helo job75 et gilbert_RGI merci bien

job75 ça fonctionne nickel mais j'avoue que je ne pige pas tout..peu à peu

gilbert j'ai fait le test en rajoutant votre code

j'ai un message erreur de compilation
si je n'abuse pas , jetez un coup d'oeil si vous avez un instant
je verrai ainsi comment ajouter correctement un morceau de code à une marco

merci
urbanito1

 

[gilbert_RGI]

Re : Completer une macro enregistree - debutant

juste supprimer

End Sub
Sub sup()

qui est en rouge

mais à la lecture de votre code il y a un problème d'execution

le fichier de job75 est bien plus élaboré

Edit : bonjour job75

 

[urbanito1]

Re : Completer une macro enregistree - debutant

effectivement il affiche erreur d'exécution 1004
le débogage donne ceci


Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _st
:=")", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True


que convient-il de modifier?
urbanito1

 

[urbanito1]

Re : Completer une macro enregistree - debutant

je vais utiliser le fichier de job

j'aurai plein d'autres questions bientôt

merci bien et bonne fête de Pâques
urbanito1

 

[job75]

Re : Completer une macro enregistree - debutant

Re,

En réponse au post 7, lancez votre macro sur la liste non traitée (celle du fichier liste initiale excel download1.xlsx‎).

A+

 

[urbanito1]

Re : Completer une macro enregistree - debutant

helo job
je viens d'essayer
extra

Merci bien et à la prochaine

 

[job75]

Re : Completer une macro enregistree - debutant

Bonjour urbanito1, Gilbert, le forum,

Voici une version (2) qui utilise la conversion de données :

Sub TraiterListe()
If [B1] Like "Matricule*" Then Exit Sub 'liste déjà traitée
Dim supp, h&
supp = 200 'adapter la valeur à supprimer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next 'si les SpecialCells n'existent pas
h = Cells(Rows.Count, 1).End(xlUp).Row
[B:B].Insert 'insertion de 2 colonnes
[B:B].Insert
[A1].Resize(h).TextToColumns [A1], xlDelimited, Other:=True, OtherChar:="("
With [B1].Resize(h)
  .TextToColumns [B1], xlDelimited, Other:=True, OtherChar:=")"
  .TextToColumns [B1], xlDelimited, Other:=True, OtherChar:=":"
  .Value = [G1].Resize(h).Value
  .Replace supp, "#N/A", LookAt:=xlWhole
  .SpecialCells(xlCellTypeConstants, 3) = 1
  'tri pour avoir les #N/A en fin de liste (suppression plus rapide)
  [A1].Resize(h, Columns.Count).Sort [B1], xlAscending
  .SpecialCells(xlConstants, 16).EntireRow.Delete
End With
[B:B].Delete
[A1] = "Nom Prénom"
[B1] = "Matricule Agent"
Columns("A:B").AutoFit 'ajustement automatique
End Sub

Testée sur 60001 lignes avec Excel 2003 : 4,3 s au lieu de 3,6 s avec la version (1) par tableau...

A+

 

[urbanito1]

Re : Completer une macro enregistree - debutant

salut job, Gilbert, le forum et merci

je viens de tester sur 91000 lignes époustouflant

si je veux choisir un autre motif...je remplace 200 par le n° du motif

mais si je souhaitais supprimer deux motifs voire plus...

supp = 200 'adapter la valeur à supprimer

que dois-je insérer à cette ligne?

 

[job75]

Re : Completer une macro enregistree - debutant

Re,

Pour supprimer 2 valeurs, avec la version (1) modifiez le code ainsi :

Dim supp1, supp2, h&, tablo, i&, t$, v%, p%
supp1 = 5 'adapter la valeur à supprimer
supp2 = 200 'adapter la valeur à supprimer
'------------
  If tablo(i, 7) <> supp1 And tablo(i, 7) <> supp2 Then tablo(i, 3) = 1

A+

 

[job75]

Re : Completer une macro enregistree - debutant

Re,

Et avec la version (2) ce sera évidemment :

Dim supp1, supp2, h&
supp1 = 5 'adapter la valeur à supprimer
supp2 = 200 'adapter la valeur à supprimer
'------------
  .Replace supp1, "#N/A", LookAt:=xlWhole
  .Replace supp2, "#N/A"

Edit : en testant sur 60001 lignes avec Excel 2003, la durée d'exécution passe à 12 s.

Ce sont donc les Replace qui prennent beaucoup de temps...

A+

 

[urbanito1]

Re : Completer une macro enregistree - debutant

ce fil est pour moi plus appétissant qu'un oeuf de Pâques ...
merci