MACRO POUR ENCADRER DE MANIERE SIMPLE UNE BASE DE DONNEESRésolu

Question

Bonjour à tous,

Je ne suis pas sûr de poster mon message dans la bonne rubrique. Donc d'avance dsl si je fais erreur.

Je cherche à programmer une petite macro sous Excel 2007 me permettant d'encadrer très simplement une base de donnée sous le schéma suivant :

-Dans la colonne B se trouve la série de données :
0
0
0
0
0
1
1
1
1
1
2
2
2
2
2
3
3
3
.
.
.
30
30
30
30
30
30
31
31
31

Il s'agit simplement d'un exemple. La longueur de ces données est dynamique et n'occupe donc pas un nombre de ligne fixe. Chaque série commence de 0 et est incrémentée jusqu'à une certaine valeur variable. Chaque valeur 0,1,2...est reportée de nombreuse fois à l'identique. C'est à dire que le chiffre 0 sera mis 10 fois de suite, puis on mettra 5 fois le chiffre 1, puis 129 fois le chiffre 2, puis 45 fois le chiffre 3 et ainsi de suite jusqu'à atteindre la valeur finale requise.

Mon objectif est de supprimer certaines lignes qui ne m'intéressent pas. Il S'agit de supprimer les 2 premières lignes et les deux dernières lignes associer à chaque chiffre.
Ainsi pour le chiffre 0 je vais supprimer les 2 premières lignes, garder le reste et finalement supprimer les 2 dernières lignes ou le chiffre 0 se répète. Ensuite on fait de même avec le chiffre 1 en supprimant ses 2 premières occurrences ainsi que ses 2 dernières. Il s'agit bien de supprimer TOUTE la ligne et pas uniquement une case.

Voila, pour résumer je cherche à épurer une liste de valeurs identiques par ses extrêmes en supprimant les 2 premières et 2 dernières lignes.

J'ai essayé avec des boucles et des condition mais je n'y parviens pas. Voila mon idée de départ^^

For i = 1 To i=n '(n étant le nombre de lignes total du tableau)

If Cells(i, 2) <> Cells(i + 1, 2) Then Rows("i:i-2").Select and Rows("i:i+2").Select '(on travail sur la colonne B)
Selection.Delete Shift:=xlUp

Next


Mais cela ne marche pas. Je suis trop débutant.

Merci à ceux qui pourrons m'éclairer par un petit bout de code^^

André

SERIEUXETCOOL · Accepted Answer

Finalement Tu avais raison Ucfoutu !!!

Il s'agissait bien du "nb=5" qui me bloquais tout. En effet manque de chance, j'ai voulu mettre 5 lignes à supprimer. Et comme mes séries faisaient toutes 10 lignes ben c'est normal que je me retrouvais sans aucune données à l'écran. La marco me supprimait tout en intégralité.

Donc en effet, rien qu'en changeant ce petit chiffre sa a fait toute la différence. Comme quoi, tu avais bien eu raison d&#8217;insister au tout début sur le fait que l'on doive bien supprimer moins de lignes que n'en contient la série au total.

Excellente vue ;)

Du coup sans le faire exprès, je viens de montrer une faille importante de ton code. Il serait bon d'arrêter la macro et de prévenir l'utilisateur qu'il cherche à supprimer plus (ou autant) de lignes que la plus petites des séries.

Prenons par exemple que la série concernant le chiffre le 34 ne sois répétée que 8 fois alors que toutes les autres séries contiennent au moins 50 valeurs. Si on demande à ta macro de supprimer les 5 lignes du bas ET les 5 lignes du haut (sois 10 lignes) alors on supprimera complètement la série numéro 34. Ce qui aura pour conséquence de créer un "manque" dans la série des nombres entier. En effet sa fera ...31/32/33/35... La série 34 aura disparue et l'utilisateur n'en saura pas averti. C'est embêtant pour la suite de mon programme sa.

Il faudrait faire une comparaison entre le nombre de lignes au total que l'on souhaite supprimer ET le nombre de lignes de chaque série pour ne pas les détruire.

C'est la première petite subtilité qui ferait la différence je pense. Et Il reste une dernière petite subtilité aussi. Quand on met "nb=0" la première des lignes est quand même supprimée. Alors qu'on demande de supprimer 0 lignes. C'est un peu trompeur et sa peu être embêtant pour la suite aussi. Cela est due je pense au fait que tu initialise la plage à supprimer sur la valeur de la plage à ne pas supprimer. Et donc ta première valeur figure sur la liste alors qu'elle ne devrait pas l'être. Ou alors cela est due à ton conteur qui démarre un cran trop haut ou trop bas.

Je place ici le code qui pour le moment semble bien fonctionner mise à part les 2 subtilités énoncées ci-dessus.


Sub Macro1()
Cells.Clear ' Vide la feuille

Dim plage As Range, plage_a_supp As Range
Dim nb As Integer, n As Integer, i As Integer, j As Integer
 
Cells(1, 1) = "0"
Cells(2, 1) = "0"
Cells(3, 1) = "0"
Cells(4, 1) = "0"
Cells(5, 1) = "0"
Cells(6, 1) = "0"
Cells(7, 1) = "0"
Cells(8, 1) = "0"
Cells(9, 1) = "0"
Cells(10, 1) = "0"
Cells(11, 1) = "1"
Cells(12, 1) = "1"
Cells(13, 1) = "1"
Cells(14, 1) = "1"
Cells(15, 1) = "1"
Cells(16, 1) = "1"
Cells(17, 1) = "1"
Cells(18, 1) = "1"
Cells(19, 1) = "1"
Cells(20, 1) = "1"
Cells(21, 1) = "2"
Cells(22, 1) = "2"
Cells(23, 1) = "2"
Cells(24, 1) = "2"
Cells(25, 1) = "2"
Cells(26, 1) = "2"
Cells(27, 1) = "2"
Cells(28, 1) = "2"
Cells(29, 1) = "2"
Cells(30, 1) = "2"
Cells(31, 1) = "3"
Cells(32, 1) = "3"
Cells(33, 1) = "3"
Cells(34, 1) = "3"
Cells(35, 1) = "3"
Cells(36, 1) = "3"
Cells(37, 1) = "3"
Cells(38, 1) = "3"
Cells(39, 1) = "3"
Cells(40, 1) = "3"

Cells(1, 2) = "1"
Cells(2, 2) = "2"
Cells(3, 2) = "3"
Cells(4, 2) = "4"
Cells(5, 2) = "5"
Cells(6, 2) = "6"
Cells(7, 2) = "7"
Cells(8, 2) = "8"
Cells(9, 2) = "9"
Cells(10, 2) = "10"
Cells(11, 2) = "1"
Cells(12, 2) = "2"
Cells(13, 2) = "3"
Cells(14, 2) = "4"
Cells(15, 2) = "5"
Cells(16, 2) = "6"
Cells(17, 2) = "7"
Cells(18, 2) = "8"
Cells(19, 2) = "9"
Cells(20, 2) = "10"
Cells(21, 2) = "1"
Cells(22, 2) = "2"
Cells(23, 2) = "3"
Cells(24, 2) = "4"
Cells(25, 2) = "5"
Cells(26, 2) = "6"
Cells(27, 2) = "7"
Cells(28, 2) = "8"
Cells(29, 2) = "9"
Cells(30, 2) = "10"
Cells(31, 2) = "1"
Cells(32, 2) = "2"
Cells(33, 2) = "3"
Cells(34, 2) = "4"
Cells(35, 2) = "5"
Cells(36, 2) = "6"
Cells(37, 2) = "7"
Cells(38, 2) = "8"
Cells(39, 2) = "9"
Cells(40, 2) = "10"

n = ActiveSheet.UsedRange.Rows.Count 'Compte le nombre de lignes dynamiques
nb = 2 'pour ôter 2 lignes en bas et 2 en haut

If plage Is Nothing Then
  Set plage = Range("A1")
 Set plage_a_supp = plage
End If
 
 For i = 2 To n + 1 ' Après-dernière ligne du tableau
   If Range("A" & i).Value = Range("A" & i - 1).Value Then
    Set plage = Union(plage, Range("A" & i))
 Else
If plage.Rows.Count >= nb * 2 Then
  For j = 1 To nb
   Set plage_a_supp = Union(plage_a_supp, plage(j, 1), plage(plage.Rows.Count + 1 - j, 1))
Next
Set plage = Range("A" & i)
If Range("A" & i).Value = "" Then Exit For
     End If
     End If
  Next
   plage_a_supp.EntireRow.Delete
End Sub

Merci Ucfoutu en tout cas pour l'aide déjà apportée ! C'est très bien comme sa.

PS : j'ai modifié la ligne suivante comme suis

For i = 2 To n + 1 ' Après-dernière ligne du tableau

J'ai du mettre "n + 1" car sinon la dernière série n'était pas transformée. Peut être qu'à cause de sa, je supprime maintenant tout le tps la première ligne du coup ???

NHenry · Answer

Bonjour,

Ce que tu peux faire, c'est commencer du bas de ton tableau (car si tu supprimes une ligne, les autres remontent).

Ensuite, tu fais une boucle où tu notes le début et la fin de la zone (premier et dernier numéro de ligne).

Ensuite, une fois ces informations, tu peux supprimer les lignes désirées.

Concernant la catégorie, c'est VBA, pas VB.NET. Je déplace donc.

--------------------------------------------------
[list][*]Quand vous postez un code, merci d'utiliser la coloration syntaxique (3ième icône en partant de la droite : )
[*]Si votr

SERIEUXETCOOL · Answer

Merci bien pour ce début d'information.
J'ai bien remarqué que lorsque que je supprimais mes lignes remontaient et cela me gênais.

Je vais essayer de voir si je me débrouille avec ton aide. Si je comprends bien, tu me conseille de récupérer l'indice représentant la première ligne ainsi que la dernière ligne. Une fois ces deux indices en ma possession je devrais pouvoir supprimer d'autres lignes.

L'idée me parait acceptable...Mais étant débutant je ne vois pas comment récupérer l'indice des lignes.

Je verrais bien une boucle tant que, ou alors if qui me compare deux lignes deux à deux jusqu&#8217;à ce que les cellules ne soient plus identiques.

Mais en programmation voila quoi.


Mais merci tout de même. Je vais essayer de tester sa.

NHenry · Answer

Bonjour, 

Tu recherches le bas du tableau, puis tu fais :

Do while i>0
If Cells(i,1).Value<>Cells(i+1,1).Value Then
'Changement
End If
i=i-1
Loop

Avec i représentant le numéro de ligne, initialisé à la valeur de la dernière ligne du tableau.

On peut obtenir la même boucle avec un For :
For i=Max to 1 Step -1

A toi de voir si ça répond à une partie de ta question.

---------------------------------------------------------------------
[list][*]Quand vous postez un code, merci d'utiliser la coloration syntaxique (3ième icône en partant de la droite : )
[*]Si votre problème est résolu, pensez à mettre "Réponse acceptée" sur le ou les messages qui vous ont aidés./list
---
Mon site

ucfoutu · Answer

Bonjour,
Voila, pour résumer je cherche à épurer une liste de valeurs identiques par ses extrêmes en supprimant les 2 premières et 2 dernières lignes. 

c'est assez simple à mettre en oeuvre dès lors que la colonne qui contient ces valeurs est triée (est-ce bien le cas ?), que dans chaque groupe, le nombre de valeurs est > 4 (est-ce toujours le cas ?)
La mise en oeuvre peut être faite par des mécanismes diffétrents, parmi lesquels choisir en fonction du contexte.
Je préfèrerais en ce qui me concerne la "fabrication" (par Union) d'une plage des lignes à supprimer, puis leur suppression in fine, sur cette plage (ce qui éviterait beaucoup d'acrobaties annexes).
On y viendra en fonction de tes réponses à ces questions, mais un point m'inquiète : comment comptes-tu t'assurer de ce que de telles instructions ne pourront être exécutées qu'une sule fois (pour des raisons bien évidentes) ?
Voilà tout ce qui me vient pour l'instant à l'esprit, sur la seule base de ce que tu as écrit. Je me demande si tu nous as vraiment tout dit sur ce que tu appelles "épuration" de tes données et crains de te conduire, du fait d'éventuelles imprécisions, à une petite catastrophe. 


____________________
Utiliser le bouton "REPONSE ACCEPTEE" sur une réponse exacte facilite les recherches ultérieures d'autres forumeurs. PENSEZ-Y SVP

SERIEUXETCOOL · Answer

Bonjour NHenry et merci pour ton aide.

(Petite précision je ne sais pas comment insérer mon code VBA avec la bonne légende du site, donc dsl de le coller brutalement)

Pour ce qui est de récupérer la dernière ligne de mon tableau je l'ai fait. le code est le suivant :

Max = ActiveSheet.UsedRange.Rows.Count 'Compte le nombre de lignes dynamiques

Pour me rendre à la case la plus en bas j'utilise :

Range("B2" & ":F" & n).Select

J'ai aussi remarqué que pour accéder au contenu d'une cellule j'utilisais :

Cells(i,1)

Alors qu'en fait il faut utiliser :

Cells(i,1).Value

Sa va beaucoup m'aider sa. Donc merci.

De plus tu propose le choix entre une boucle tant que et pour. Je préfère la boucle pour :

For i=Max to 1 Step -1

If Cells(i,1).Value<>Cells(i+1,1).Value Then
             Rows("i:i-100").Delete
             Selection.Delete Shift:=xlUp
End If
i=i-1
Next


Mais sa ne sembla pas fonctionner

SERIEUXETCOOL · Answer

Salut Ucfoutu,

Pour répondre à tes questions, alors oui la colonne qui contient la série est triée par ordre croissant. Mais la série contenant le chiffre 0 n'est pas forcément de la même taille que la série contenant le chiffre 1.

Par contre chaque série, contient au moins 20 fois l&#8217;occurrence. Donc on peut supprimer les 2 premières et 2 dernières lignes sans aucun souci.


Disons qu'en effet j'ai prévu de poursuivre le développement de ma Macro par la suite. Mais les opérations suivantes me poseront moins de problèmes. La je bloque car je n'arrive pas à supprimer ces quelques lignes sur l'ensemble de ma base de données.

Cette suppression de lignes n'est à faire qu'une seule fois. Elle sera implémentée au bon endroit dans ma Macro. Elle fait partie de ce que j'appelle la mise en forme de mes données. Je dois parvenir à supprimer TOUTES les premières et dernières lignes de chaque série débutant de 0 à une certaine valeur non fixe.

Pour rappel chaque série est incrémenté de 1 et est rangée dans la même colonne par ordre croissant.

Voila pour les infos.

D'avance Merci

ucfoutu · Answer

Ouais.
Bon
Je croyais t'avoir pourtant suffisamment dévoilé ma pensée pour que tu la mettes en oeuvre.
Ce n'est apparemment pas le cas !
Je vais donc faire moi-même cette mise en oeuvre.  ===>> regarde
Private Sub CommandButton1_Click()
 epure
End Sub

Private Sub epure()
   Dim plage As Range, plage_a_supp As Range
   If plage Is Nothing Then
     Set plage = Range("B1")
     Set plage_a_supp = plage
   End If
   For i = 2 To Rows.Count ' je me moque même de déterminer la dernière ligne remplie
     If Range("B" & i).Value = Range("B" & i - 1).Value Then
       Set plage = Union(plage, Range("B" & i))
     Else
       If plage.Rows.Count >= 4 Then
         Set plage_a_supp = Union(plage_a_supp, plage(1, 1), plage(2, 1), plage(plage.Rows.Count - 1, 1), plage(plage.Rows.Count))
         Set plage = Range("B" & i)
         If Range("B" & i).Value = "" Then Exit For
       End If
     End If
   Next
   plage_a_supp.EntireRow.Delete
End Sub
Et essaye de comprendre. C'est facile car logique 



____________________
Utiliser le bouton "REPONSE ACCEPTEE" sur une réponse exacte facilite les recherches ultérieures d'autres forumeurs. PENSEZ-Y SVP

SERIEUXETCOOL · Answer

Bonsoir Ucfoutu,

Tout d'abord merci pour ton aide. Évidement, c'est facile quand on sais de quoi on parle. Mais je suis débutant sous vba et plus largement en programmation.

Je pense bien avoir compris ton code. Tu divise ma base de donnée en 2 listes. Une première liste contenant un ensemble de lignes qui sont les bonnes puis la deuxième liste qui contient l'ensemble de toutes les lignes à supprimer.

J'ai essayé d'appliquer ton code à  ma marco et sa à l'air de marcher en effet.

Le souci c'est que je ne comprends pas vraiment en détail ton code. Étant débutant, je ne maitrise pas la fonction union. Et c'est en partie la ou ton code deviens plus embêtant pour moi. Mettons que je ne veuille plus supprimer les 2 premières lignes et 2 dernières lignes de chaque série mais plutôt les 150 premières et 150 dernières en admettant par exemple que la base de données sois plus étalée. Je me vois mal faire l'union une à une pour les 300 lignes de chaque boucle.

Set plage_a_supp = Union(plage_a_supp, plage(1, 1), plage(2, 1), plage(plage.Rows.Count - 1, 1), plage(plage.Rows.Count))


Cette ligne de code ci-dessus en partie me pose problème pour la traduire.

Du coup j'ai vraiment du mal à l'adapter de manière serraine.

En tout cas sa semble fonctionner de base.

ucfoutu · Answer

Ben !
Fastoche !
Je n'ai pas voulu sortir la pelle mécanique pour 2 seulement ! Mais si tu dois arriver maintenant à "écrêter" de manière plus "élastique" :
Ceci (fait par modif à main levée, sans tester) sera toujours vrai ====>>>


......
Dim nb As Integer
nb 8 '>> pour en oter 8 à chaque extrémité.
........
........
Else
       If plage.Rows.Count >= nb Then
         For i = 1 To nb
            Set plage_a_supp = Union(plage_a_supp, plage(nb, 1), plage(plage.Rows.Count + 1 - nb, 1))
         Next
         Set plage = Range("B" & i)
         If Range("B" & i).Value = "" Then Exit For
       End If
     End If
.......
.......





Étant débutant, je ne maitrise pas la fonction union
Il n'y a rien à maîtriser, dans cette fonction, dont la seule vocation est de constituer une plage de plages, par ajouts !
Tu n'as, pour la comprendre, besoin de rien d'autre que ce qui t'en est dit dans l'aide VBA. Je ne vois d'ailleurs vraiment pas ce que l'on pourrait en dire de plus .


____________________
Utiliser le bouton "REPONSE ACCEPTEE" sur une réponse exacte facilite les recherches ultérieures d'autres forumeurs. PENSEZ-Y SVP

ucfoutu · Answer

Attention (voilà ce que c'est, que de faire "à main levée"  et dans "la foulée" :
C'est bien entendu i et pas nb dans ===>>


Set plage_a_supp = Union(plage_a_supp, plage(i, 1), plage(plage.Rows.Count + 1 - i, 1))

Mais tu aurais probablement su corriger toi-même, non ?


____________________
Utiliser le bouton "REPONSE ACCEPTEE" sur une réponse exacte facilite les recherches ultérieures d'autres forumeurs. PENSEZ-Y SVP

SERIEUXETCOOL · Answer

Salut Ucfoutu,

J'ai bien appliqué les modifications que tu me conseille mais cela ne fonctionne toujours pas on dirais.

Merci pour ta deuxième correction mais il me semble que c'est encore pire au final. Je n'obtiens plus aucun résultat sur ma feuille Excel. Toutes mes données sont supprimées.

Sa doit venir du fait que tu utilise 2 boucles If avec le même indice i. sa créé un conflit. J'ai essayé en dissociant i et j mais rien n'y fait.

Voici ci-dessous le code que j'utilise pour faire mes tests. Il est constitué de 2 colonnes. La deuxième ne sert que de contrôle pour s'assurer que l'on supprime bien les bonnes lignes, au bon endroit et au nombre désiré.


Sub Macro1()


Dim plage As Range, plage_a_supp As Range
 Dim nb As Integer
 Dim j As Integer
 
 
Cells(1, 1) = "0"
Cells(2, 1) = "0"
Cells(3, 1) = "0"
Cells(4, 1) = "0"
Cells(5, 1) = "0"
Cells(6, 1) = "0"
Cells(7, 1) = "0"
Cells(8, 1) = "0"
Cells(9, 1) = "0"
Cells(10, 1) = "0"
Cells(11, 1) = "1"
Cells(12, 1) = "1"
Cells(13, 1) = "1"
Cells(14, 1) = "1"
Cells(15, 1) = "1"
Cells(16, 1) = "1"
Cells(17, 1) = "1"
Cells(18, 1) = "1"
Cells(19, 1) = "1"
Cells(20, 1) = "1"
Cells(21, 1) = "2"
Cells(22, 1) = "2"
Cells(23, 1) = "2"
Cells(24, 1) = "2"
Cells(25, 1) = "2"
Cells(26, 1) = "2"
Cells(27, 1) = "2"
Cells(28, 1) = "2"
Cells(29, 1) = "2"
Cells(30, 1) = "2"
Cells(31, 1) = "3"
Cells(32, 1) = "3"
Cells(33, 1) = "3"
Cells(34, 1) = "3"
Cells(35, 1) = "3"
Cells(36, 1) = "3"
Cells(37, 1) = "3"
Cells(38, 1) = "3"
Cells(39, 1) = "3"
Cells(40, 1) = "3"

Cells(1, 2) = "1"
Cells(2, 2) = "2"
Cells(3, 2) = "3"
Cells(4, 2) = "4"
Cells(5, 2) = "5"
Cells(6, 2) = "6"
Cells(7, 2) = "7"
Cells(8, 2) = "8"
Cells(9, 2) = "9"
Cells(10, 2) = "10"
Cells(11, 2) = "1"
Cells(12, 2) = "2"
Cells(13, 2) = "3"
Cells(14, 2) = "4"
Cells(15, 2) = "5"
Cells(16, 2) = "6"
Cells(17, 2) = "7"
Cells(18, 2) = "8"
Cells(19, 2) = "9"
Cells(20, 2) = "10"
Cells(21, 2) = "1"
Cells(22, 2) = "2"
Cells(23, 2) = "3"
Cells(24, 2) = "4"
Cells(25, 2) = "5"
Cells(26, 2) = "6"
Cells(27, 2) = "7"
Cells(28, 2) = "8"
Cells(29, 2) = "9"
Cells(30, 2) = "10"
Cells(31, 2) = "1"
Cells(32, 2) = "2"
Cells(33, 2) = "3"
Cells(34, 2) = "4"
Cells(35, 2) = "5"
Cells(36, 2) = "6"
Cells(37, 2) = "7"
Cells(38, 2) = "8"
Cells(39, 2) = "9"
Cells(40, 2) = "10"


nb 5 '>> pour en oter 5 à chaque extrémité.
If plage Is Nothing Then
    Set plage = Range("A1")
   Set plage_a_supp = plage
End If
   For i = 2 To Rows.Count ' je me moque même de déterminer la dernière ligne remplie
     If Range("A" & i).Value = Range("A" & i - 1).Value Then
       Set plage = Union(plage, Range("A" & i))
     Else
     If plage.Rows.Count >= nb Then
        For j = 1 To nb
          Set plage_a_supp = Union(plage_a_supp, plage(j, 1), plage(plage.Rows.Count + 1 - j, 1))
      Next
     Set plage = Range("A" & i)
     If Range("A" & i).Value = "" Then Exit For
     End If
     End If
  Next
   plage_a_supp.EntireRow.Delete
End Sub


Voila ou j'en suis aujourd'hui. Je galère depuis ce matin pour essayer d'y parvenir mais j'avance pas beaucoup si on peut dire^^. Merci à ceux qui apporterons un peu d'aide.

Et d'avance merci à toi Ucfoutu ;)

ucfoutu · Answer

Je suis éloigné de ma machine et ne peut tester, mais :
Oui c'est for J et non for I puisque l'on était dans une boucle I.
Mais (autre oubli de ma part)
il faut remplacer
If plage.Rows.Count >= nb Then 
par 
If plage.Rows.Count >= nb * 2 Then  
puisque l'on supprime nb lignes à chacune des 2 extrêmités.
Je reviendrai ce soir, si cela ne va pas (dis-nous), quand je serai sur ma machine, mais je pense que ce n'est que cela.


____________________
Utiliser le bouton "REPONSE ACCEPTEE" sur une réponse exacte facilite les recherches ultérieures d'autres forumeurs. PENSEZ-Y SVP

SERIEUXETCOOL · Answer

Et bien dsl Ucfoutu, mais sa ne semble toujours pas fonctionner.

Le résultat que j'obtiens ne corresponds pas du tout à mon besoin. Loin de la en fait! Car sa supprime certaines lignes qui ne devraient pas être supprimées. Et je me retrouve avec un fichier qui n'est pas du tout celui escompté. La logique que tu as utilisé me semble bonne. Mais je pense que sa programmation est mal implémentée à peu de chose prêt.

Tu verras quand tu seras devant ta machine et que tu testera le petit bout de code. Il ne dois pas manquer grand chose je pense.

En attendant ce soir, bonne journée. Je vais continuer de me casser la tête dessus...

Merci

ucfoutu · Answer

Et si ce n'était bien que cela, rappelle-toi ma question, lorsqu'il ne s'agissait que de 2 lignes à supprimer au béut et à la fin de chaque groupe :
c'est assez simple à mettre en oeuvre dès lors que la colonne qui contient ces valeurs est triée (est-ce bien le cas ?), que dans chaque groupe, le nombre de valeurs est > 4 (est-ce toujours le cas ?) 

C'est néanmoins spontanément que j'ai ajouté un garde-fou.
Et ton exemple (suppression de 5 lignes au début et à la fin) alors que le nombre d'articles d'un goupe est >= 10 montre bien que j'avais raison d'insister sur ce point !
Non ? 

____________________
Utiliser le bouton "REPONSE ACCEPTEE" sur une réponse exacte facilite les recherches ultérieures d'autres forumeurs. PENSEZ-Y SVP

SERIEUXETCOOL · Answer

Bon je reviens vers toi Ucfoutu car depuis tout à l'heure je n'avance rien du tout.

Alors je vais de nouveau répondre à tes questions :

-La colonne qui contient les données est belle et bien triée. Comme tu peux le voir sur le code que j'ai mis sur dans mon précédent post, la colonne 1 commence par des 0 puis enchaine sur une série de 1 puis sur 2 puis sur 3. Donc elle est très bien triée.

-Dans chaque groupe, le nombre de valeur n'est pas identique mais toujours supérieur à 4 en effet. Dans mon exemple, pour faire simple, j'ai mis tout le temps 10 fois la même valeur pour chaque groupe.

-Que j&#8217;essaie de supprimer 2 ou 5 lignes sa me fait le même problème. Je pensais supprimer 5 lignes mais en effet on ne peut pas supprimer 5 lignes au total. Car sa ferait 2,5 en bas et 2,5 en haut. Ce nombre ne peut être que pair et entier. Donc en effet je n'ai pas interrêt à utiliser le nombre 5 pour mes essais car c'est litigieux. Bonne remarque ;)

-Je vais donc poursuivre les futurs tests avec la valeur de 2 qui au moins ne poseras pas de problème. Pour info, mon vrai fichier comporte plusieurs millier de lignes dont chaque occurrence est répétée plusieurs centaine de fois.

Je vais tenter de nouveau. On verra bien si en changeant 5 par 2 sa me change la vie^^

Merci encore

NHenry · Answer

Bonjour, 

Si ton pb est résolu :

[list][*]Quand vous postez un code, merci d'utiliser la coloration syntaxique (3ième icône en partant de la droite : )
[*]Si votre problème est résolu, pensez à mettre "Réponse acceptée" sur le ou les messages qui vous ont aidés./list
---
Mon site

SERIEUXETCOOL · Answer

Ce code est presque terminé. Il reste toute fois 2 petits réglages à apporter pour qu'il devienne vraiment très fonctionnel.

Je n'oublierais pas de mettre résolu dès que le code sera terminé. Sinon plusieurs versions circuleront et ce n'est pas agréable.

Je poursuis encore mes recherches pour résoudre ces 2 points manquants.

Merci pour le conseil syntaxique lié au code. J'ai répéré cette fameuse icône. Je tacherais de l'utiliser la prochaine fois.

SERIEUXETCOOL · Answer

Bonsoir Ucfoutu,

Merci de ton retour et pour cette petite modification. La subtilité concernant l&#8217;effacement de la première ligne est maintenant à tout jamais réglée. Impeccable.

Ne reste plus qu'a modifier légèrement le code pour faire en sorte que lorsque l'utilisateur demande à supprimer plus de lignes que le groupe n'en comporte ; alors ne rien supprimer du tout (sur ce groupe la UNIQUEMENT) et passer au groupe suivant pour le réduire. Si possible afficher un message à l'écran indiquant à l'utilisateur "que certains groupe n'ont pas été réduits car il n'est pas possible de supprimer plus de lignes que le groupe n'en contient". On va se la jouer comme sa plutôt. Sa ne doit pas compliquer la tâche pour toi. Sa restera une subtilité et c'est mieux ainsi.

Je poste ci-après le code complet actuel qui fonctionne le mieux actuellement.

Sub Macro1()
Cells.Clear ' Vide la feuille

Dim plage As Range, plage_a_supp As Range
Dim nb As Long, n As Long, i As Long, j As Long
Dim t, ii As Byte

t = Split("1 11 21 31") 'Permet de créer une petite table pour exemple
For ii = 0 To 3
Cells(t(ii), 1).Resize(10) = ii
Cells(t(ii), 2).Resize(10) = [=TRANSPOSE({1,2,3,4,5,6,7,8,9,10})]
Next ii

n = ActiveSheet.UsedRange.Rows.Count 'Compte le nombre de lignes dynamiques
nb = 4 'pour ôter 4 lignes en bas et 4 en haut

   If nb = 0 Then Exit Sub
   For i = 2 To n + 1
     If Range("A" & i).Value = Range("A" & i - 1).Value Then
       If plage Is Nothing Then
         Set plage = Union(Range("A" & i - 1), Range("A" & i))
       Else
         Set plage = Union(plage, Range("A" & i))
       End If
     Else
       If plage.Rows.Count >= nb * 2 Then
         For j = 1 To nb
            If plage_a_supp Is Nothing Then
            
              Set plage_a_supp = Union(plage(1, 1), plage(plage.Rows.Count, 1))
            Else
              Set plage_a_supp = Union(plage_a_supp, plage(j, 1), plage(plage.Rows.Count + 1 - j, 1))
            End If
         Next
         Set plage = Range("A" & i)
         If Range("A" & i).Value = "" Then Exit For
       Else
         Set plage = Nothing
         If Range("A" & i).Value = "" Then Exit For
       End If
     End If
   Next
   plage_a_supp.Rows.EntireRow.Delete
End Sub

-Ne reste donc plus qu'a implémenter cette dernière petite chose. Et je pourrais clore cette discussion...Pour mieux en relancer une nouvelle^^

Et oui Ucfoutu j'aurais encore besoin que la Macro exécute une petite acrobatie après avoir supprimé toutes ces lignes. Rien de bien méchant mais trop pour moi. Je t'en parlerais demain à ton retour, quand tu seras plus frais^^. Ah oui plutôt demain soir, car journée de travail demain...

Pour tout ce que tu as fais, et pour tout ceux qui m'ont déjà bien aidé pour obtenir ce code; un grand merci !

Je met comme réponse acceptée.

ucfoutu · Answer

Voilà donc ton rajout géré :
Sub Macro1()
  Cells.Clear ' Vide la feuille

  Dim plage As Range, plage_a_supp As Range
  Dim nb As Long, n As Long, i As Long, j As Long, msg As String
  Dim t, ii As Byte

  t = Split("1 11 21 31") 'Permet de créer une petite table pour exemple
  For ii = 0 To 3
     Cells(t(ii), 1).Resize(10) = ii
     Cells(t(ii), 2).Resize(10) = [=TRANSPOSE({1,2,3,4,5,6,7,8,9,10})]
  Next ii
  n = ActiveSheet.UsedRange.Rows.Count 'Compte le nombre de lignes dynamiques
  nb = 4 'pour ôter 4 lignes en bas et 4 en haut
   If nb = 0 Then Exit Sub
   msg = ""
   For i = 2 To n + 1
     If Range("A" & i).Value = Range("A" & i - 1).Value Then
       If plage Is Nothing Then
         Set plage = Union(Range("A" & i - 1), Range("A" & i))
       Else
         Set plage = Union(plage, Range("A" & i))
       End If
     Else
       If plage.Rows.Count >= nb * 2 Then
         For j = 1 To nb
           If plage_a_supp Is Nothing Then
             Set plage_a_supp = Union(plage(1, 1), plage(plage.Rows.Count, 1))
           Else
             Set plage_a_supp = Union(plage_a_supp, plage(j, 1), plage(plage.Rows.Count + 1 - j, 1))
           End If
         Next
         Set plage = Range("A" & i)
         If Range("A" & i).Value = "" Then Exit For
       Else
         msg = msg & " - " & plage(1, 1).Value
         Set plage = Nothing
         If Range("A" & i).Value = "" Then Exit For
       End If
     End If
   Next
   If Not plage_a_supp Is Nothing Then
     plage_a_supp.Rows.EntireRow.Delete
   End If
   If msg <> "" Then
     MsgBox "les groupes suivants, d'un nombre non suffisant, " & _
     "n'ont pas été traités " & vbCrLf & Mid(msg, 3)
   End If
End Sub

____________________
Utiliser le bouton "REPONSE ACCEPTEE" sur une réponse exacte facilite les recherches ultérieures d'autres forumeurs. PENSEZ-Y SVP

MACRO POUR ENCADRER DE MANIERE SIMPLE UNE BASE DE DONNEES

24 réponses

Votre réponse

Discussions similaires