besoin d'aide pour écrire une macro sous VBA

[fredd]

Bonjour j'ai besoin de faire une petit programme pour archiver des lignes d'une feuille en fonction de critère, les couper et les place dans un autre onglet d'archivage.

j'ai un peu de mal avec les loop unloop untils if, end if...

J'ai eu quelques formation mais je retrouve plus cette logique.

Ma base de programme :
10 je vais en AF10 de l'onglet actif
20 Est ce que la cellule est vide?
- 30 OUi, je stoppe la macro
- 40 NON Est ce que la cellule est = "Terminé"
- - 50 NON, je descent d'un case et je remonte en étape 20
- - 60 OUi:
- - 70 j'enregistre ma position active pour revenir à cette cellule
- - 80 je coupe la ligne entiere
- - 90 Je vais dans l'onglet archive en B10
- - 100 je descend jusqu'a la premiere case vide
- - 110 j'insere ma ligne coupé
- - 120 je retourne dans ma position active de l'onglet principale mémorisé
- - 130 je reboucle en 20

je ne sais pas si c'est assez clair?

 

[vgendron]

Re : besoin d'aide pour écrire une macro sous VBA

Bonjour
pour un début, ca m'a l'air pas mal. au moins tu sembles avoir une idée claire de ce que tu veux faire
pour que l'on puisse t'aider efficacement, il faudrait juste que tu postes un fichier exemple avec quelques données (non confidentielles)

sinon, en attendant, tu peux aussi aller voir l'aide de VBA (Alt+F11 pour ouvrir l'éditeur) puis F1: tu y trouvera les explications avec exemples des boucles et test: If then else, do loop until.. while/Wend etc etc

 

[fredd]

Re : besoin d'aide pour écrire une macro sous VBA

ben disont que je me suis fais ma base pour construire le programme.
Le fait d'écrire me fait réfléchir au fonction pour me remémorer les quelques fonctions que j'avais vue.
Je vais construire un document en exemple.

 

[fredd]

Re : besoin d'aide pour écrire une macro sous VBA

Je viens poser le fichier.
En VBA, Module 1, j'ai commencé à écrire la macro.

 

[ROGER2327]

Re : besoin d'aide pour écrire une macro sous VBA

Bonjour à tous.

Un essai sur la base des indications du premier message.​

Bonne journée.


ℝOGER2327
#7539

Dimanche 1[SUP]er[/SUP] Absolu 142 (Nativité d’Alfred Jarry - fête Suprême Première première)
22 Fructidor An CCXXII, 4,3078h - noisette
2014-W37-1T10:20:19Z

 

[fredd]

Re : besoin d'aide pour écrire une macro sous VBA

Bonjour Roger, (EDIT: j'ai oublié de dire merci ) j'ai essayé ce fichier et il fonctionne à un détaille pres, mais qui reste assez simple, c'est de supprimer la ligne coupé qui reste vide.
Cependant, je comprend pas pourquoi je n'arrive pas à le mettre en place dans mon formulaire... ça coince avec le bouton me semble t'il.

Sub toto()
'10 je vais en AF10 de l'onglet actif
  Me.[AF10].Select
'20 Est ce que la cellule est vide?
  Do
    Select Case Selection.Value
'- 30 OUi, je stoppe la macro
    Case Empty: Exit Sub
'- 40 NON Est ce que la cellule est = "Terminé"
'- - 60 OUi:
    Case "Terminé"
'- - 70 j'enregistre ma position active pour revenir à cette cellule
'- - 80 je coupe la ligne entiere
'- - 90 Je vais dans l'onglet archive en B10
'- - 100 je descend jusqu'a la premiere case vide
'- - 110 j'insere ma ligne coupé
    With Worksheets("archive")
      Selection.EntireRow.Cut Destination:=.Rows(PremièreCelluleVideSousDernièreCelluleNonVide(.[AF1]).Row)
      '(La fonction PremièreCelluleVideSousDernièreCelluleNonVide est dans le Module01.)
      

ActiveSheet.Rows(ActiveCell.Row).EntireRow.Delete ' je supprime la ligne active
ActiveCell.Offset(-1, 0).Select 'je remonte d'une case suite à la suppression
    
    End With
    Selection.Offset(1).Select
'- - 50 NON, je descent d'un case et je remonte en étape 20
    Case Else: Selection.Offset(1).Select
    End Select
'- - 120 je retourne dans ma position active de l'onglet principale mémorisé
'- - 130 je reboucle en 20
Loop
End Sub
-----------------------------------------------
Function PremièreCelluleVideSousDernièreCelluleNonVide(r As Range) As Range
'r étant une cellule, la fonction renvoie la Première Cellule Vide Sous la Dernière Cellule NonVide en dessous de r.
    With r.Parent.Cells(r.Parent.Rows.Count, r.Column).End(xlUp).Offset(1)
        Set PremièreCelluleVideSousDernièreCelluleNonVide = .Parent.Cells((.Row + r.Row + Abs(.Row - r.Row)) / 2, r.Column).Offset(IsEmpty(r.Value) * (r.Row = 1) * (.Row = 2))
    End With
End Function

 

[fredd]

Re : besoin d'aide pour écrire une macro sous VBA

Re bonjour, c'était juste une erreur de protection.

je joint le fichier final, est ce qu'il est possible de vérifier les éléments afin d'éviter certain bug?

Merci.

 

[ROGER2327]

Re : besoin d'aide pour écrire une macro sous VBA

Re...

On peut éviter d'utiliser Select, toujours source de lenteur.​

Sub Archiv()
Dim Dec&, Cel As Range
If MsgBox("Voulez vous archiver les éléments Terminé?", vbYesNo, "Confirmation") = vbYes Then
  Me.Unprotect
  Set Cel = Me.[AF9]: Dec = 1
  Do
    Select Case Cel.Offset(Dec).Value
    Case Empty: Exit Sub
    Case "Terminé"
      With Worksheets("archive")
        Cel.Offset(Dec).EntireRow.Cut Destination:=.Rows(PremièreCelluleVideSousDernièreCelluleNonVide(.[AF1]).Row)
      End With
      Me.Rows(Cel.Offset(Dec).Row).EntireRow.Delete
    Case Else: Dec = 1 + Dec
    End Select
  Loop
  Me.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowInsertingRows:=True, _
    AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
End If
End Sub

On peut encore accélérer en sortant l'appel à PremièreCelluleVideSousDernièreCelluleNonVide de la boucle Do... Loop.​

Sub Archiv()
Dim Dec&, Lig&, Cel As Range
If MsgBox("Voulez vous archiver les éléments terminés ?", vbYesNo, "Confirmation") = vbYes Then
  Me.Unprotect
  Set Cel = Me.[AF9]: Dec = 1
  With Worksheets("archive")
    Lig = PremièreCelluleVideSousDernièreCelluleNonVide(.[AF1]).Row
    Do
      Select Case Cel.Offset(Dec).Value
      Case "Terminé"
        Cel.Offset(Dec).EntireRow.Cut Destination:=.Rows(Lig): Lig = 1 + Lig
        Me.Rows(Cel.Offset(Dec).Row).EntireRow.Delete
      Case Empty: Exit Sub
      Case Else: Dec = 1 + Dec
      End Select
    Loop
  End With
  Me.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowInsertingRows:=True, _
    AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
End If
End Sub

Mais si le nombre de lignes à traiter est faible, ces modifications ne seront guère visibles.​

Bonne journée.


ℝOGER2327
#7541

Lundi 2 Absolu 142 (Saint Ptyx, silentiare (Abolition de) - fête Suprême Quarte)
23 Fructidor An CCXXII, 0,3316h - houblon
2014-W37-2T00:47:45Z

 

[fredd]

Re : besoin d'aide pour écrire une macro sous VBA

Bonjour Roger2327, Merci beaucoup de ton aide. Je valide mon fichier avec le 2eme code.
En effet il peut y avoir entre 100 et 300 lignes. Un petit gain est toujours bon à prendre.

j'ai du mal à comprndre avec "PremièreCelluleVideSousDernièreCelluleNonVide" mais bon, ça fonctionne. On verra plus tard quand j'aurais progresser.