Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

macro pour grouper des lignes... suite

26 réponses
Avatar
jiffey
Bonjour à tous,



Je fais suite au post qui a suscité tant de réactions (voir ma réponse dans
le post). J'espère n'avoir froissé personne et que quelqu'un pourra résoudre
mon nouveau problème...



j'ai un tableau http://cjoint.com/?hmjWGoxicV dans lequel je souhaterais
grouper les lignes limitées par DO2.


J'ai une macro mais elle fonctionne imparfaitement :


En effet, dans la colonne DO2, lorsque les cases pleines se suivent, le code
saute ces lignes (logique).
J'ai essayé avec une double condition, mais le pb, c'est que 3 "DO2" peuvent
se suivre, voire plus.

Bref, je n'y arrive pas. :-(( Mes connaissances sont trop faibles pour
résoudre ce pb.

En espérant que quelqu'un pourra m'aider

Slts



Jiffey

6 réponses

1 2 3
Avatar
MichDenis
Ceci détruit tout le code du classeur dans lequel la macro est écrite
Y compris la macro elle-même.

Sub test()

Dim Vbcomps As Object
Set Vbcomps = ThisWorkbook.VBProject.VBComponents
For Each vbcomp In Vbcomps
With vbcomp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Next

End Sub

Le hic à propos de cette procédure est si les modules sont vides
ils demeurent quand même présent....et tu continueras de recevoir
à l'ouverture de ce dernier le même à savoir si tu désires activer les
macros à cause de la présence des modules (même s'ils sont vides)

Pour tout supprimer, le te propose cette procédure :

'--------------------------------
Sub SupprimeToutCodeEtFormulaire()

Dim VBComp As Object
Dim VBComps As Object

Set VBComps =ThisWorkbook.VBProject.VBComponents

For Each VBComp In VBComps
Select Case VBComp.Type
Case 100
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Case Else
VBComps.Remove VBComp
End Select
Next VBComp

End Sub
'--------------------------------

Dernière remarque, si tu désires que ce soit les procédures d'un
classeur ouvert particulier que tu veux détruire, remplace dans chacune
des procédures proposées cette ligne de codde :

Set VBComps =ThisWorkbook.VBProject.VBComponents

Par

Set VBComps =Workbooks"(NomDuClasseur.xls").VBProject.VBComponents
Avatar
FFO
Bonjour jiffey

Méaculpa Méaculpa !!!!!!!!!!!!!

En te proposant le dernier code modifié pour la colonne DO2 au lieu
d'adapter la 2° version qui tenait compte des cellules qui se suivent non
vides j'ai adapter la 1° version

Pas de chance !!!!
Je te propose donc dans l'esprit de ne prendre que les cellules de A à E le
2° code corrigé :


Range("B65535").End(xlUp).Offset(0, 3).Select
Do While ActiveCell.Row > Range("B6").Row
Range(ActiveCell, ActiveCell.End(xlUp).Offset(1, -4)).Select
Selection.Rows.Group
If ActiveCell.Offset(-2, 4) = "" Then
ActiveCell.Offset(-2, 4).Select
Else
ActiveCell.Offset(-1, 4).End(xlUp).Offset(-1, 0).Select
End If
Loop

Ce code dans la série des 2 à mettre en une seule macro est le premier qui
traite la colonne E (DO2)

Dis moi si c'est bon !!!!!



Re bonjour FFO,

ARggghhh.... J'ai bien cru que ca marchait.. Mais hélas non car on revient
au pb de départ : la colonne 2 est mal regroupée : lorsque 2 cellules se
suivent, la ligne est incorporée dans le groupement.

Ex : 2010595 (ligne 66) dans le groupement du compte 2010593 (ligne 63),
alors que c'est un DO 2. Idem ligne 62.

Par contre, en effet on n'a pas de "conflit enter les 2 codes, de ce côté là
c'est bon.

Zut, zut, zut...

Jiffey


Rebonjour à toi

je reste persuadé qu'il ya interaction des 2 regroupements liée au fait que
l'on sollicite à chaque fois les lignes entières pour cette opération

Je te propose donc pour éviter cet inconvénient ces codes modifiés qui ne
prennent dans le regroupement que les cellules de la de colonne A à la
colonne D ou E en fonction de celle qui est traitée

Tu traites en priorité la colonne E (DO2) avec ce code :

Range("B65535").End(xlUp).Offset(0, 3).Select
Do While ActiveCell.Row > Range("B6").Row
Range(ActiveCell, ActiveCell.End(xlUp).Offset(1, -4)).Select
Selection.Rows.Group
If ActiveCell.Offset(-2, 3) = "" Then
ActiveCell.Offset(-2, 4).Select
Else
ActiveCell.Offset(-3, 4).Select
End If
Loop

Puis la colonne D (DO1) avec ce code :

Range("B65535").End(xlUp).Offset(0, 2).Select
Do While ActiveCell.Row > Range("B6").Row
Range(ActiveCell, ActiveCell.End(xlUp).Offset(1, -3)).Select
Selection.Rows.Group
If ActiveCell.Offset(-2, 3) = "" Then
ActiveCell.Offset(-2, 3).Select
Else
ActiveCell.Offset(-1, 3).End(xlUp).Offset(-1, 0).Select
End If
Loop

Tu mets donc dans une seule Macro ces 2 codes dans cet ordre

J'espère que cette fois-ci !!!!!


Merci FFO mais malheureusement cela ne marche pas car c'est vraiment
l'enchainement des 2 codes qui entraine l'erreur. Donc le fait de les mettre
dans 2 macros différentes n'y change rien.

Autrement dit : le code 1 marche pour les DO1 ; le code 2 marche pour les
DO2 ; mais code 1 + code 2 marche incorrectement pour DO1 (correctement pour
DO2 en revanche).





Rebonjours à toi

Ne soyons pas plus royaliste que le roi et devant cette incogruitée
inexplicable je te propose de mettre les 2 codes dans 2 macros différentes
et de rajouter à la fin de la première la ligne suivante :

Run ("Macro2")

Ainsi à la fin de l'exécution de la 1° macro cette instruction commandera
l'execution de la 2°

Celà devrait te permettre d'obtenir satisfaction enfin

Tiens moi au courrant


Oui FFO je te confirme c'est uniquement DO1 qui n'est pas correct. Bizarre...


Rebonjours à toi

Une précision :
Quelque soit l'ordre d'execution des 2 macros c'est toujours la colonne DO2
qui est correcte et DO1 qui ne l'est pas ????

Merci de me confirmer


Oui, c'est que j'avais fait et la première étape marche bien et c'est en
faisant la deuixème partie de la macro que ca déconne.

J'ai essayé d'inverser les codes, et c'est identique.

je ne comprends vraiment pas... C'est embêtant car je n'arrive pas au
résultat final escompté...

Si tu as des idées...

Jiffey


Rebonjours à toi

Je me demande si le regroupement de DO1 opéré par le 1° code ne serait pas
mis à mal par le regroupement de DO2 opéré par le 2° code

Il faut savoir que dans ces regroupements l'intégralité des colonnes sont
concernées puisque les lignes entières sont prises dans cette opération

Donc dans le groupement DO1 tu impactes les cellules DO2 et dans le
groupement DO2 tu impactes les cellules DO1

Fais ce test :

Met les 2 codes dans une même macro
Mets un point d'arrêt en regard de la 1° ligne du 2° code (clique à côté de
la ligne dans le bandeau gris vertical)
Exécutes la macro qui s'arrètera au point d'arrêt
Regardes le résulat du 1° regroupement
Puis retournes dans le script et fait F5 pour continuer l'exécution
Regardes le résultat du 2° regroupement et le précédent

Dis moi !!!!


Re-bonjour FFO,


Je n'ai pas tout à fait compris la solution que tu proposes. Si tu peux me
réexpliquer (sachant que de toute façon il faut que ce soit relativement
simple car la macro doit à terme être utilisée par des gens par forcément
super fort en excel).


Par contre, j'ai encore un petit souci par rapport au pb précédent :

tjs sur le tableau : qd je mets la macro

Range("B65535").End(xlUp).Offset(0, 2).Select
Do While ActiveCell.Row > Range("B6").Row
Range(ActiveCell, ActiveCell.End(xlUp).Offset(1, 0)).EntireRow.Select
Selection.Rows.Group
If ActiveCell.Offset(-2, 3) = "" Then
ActiveCell.Offset(-2, 3).Select
Else
ActiveCell.Offset(-1, 3).End(xlUp).Offset(-1, 0).Select
End If
Loop


ca me groupe bien les DO1


Qd je mets

Range("B65535").End(xlUp).Offset(0, 3).Select
Do While ActiveCell.Row > Range("B6").Row
Range(ActiveCell, ActiveCell.End(xlUp).Offset(1, 0)).EntireRow.Select
Selection.Rows.Group
If ActiveCell.Offset(-2, 4) = "" Then
ActiveCell.Offset(-2, 4).Select
Else
ActiveCell.Offset(-1, 4).End(xlUp).Offset(-1, 0).Select
End If
Loop

Ca groupe bien les DO2


Par contre,qd je combine les 2 dans une même macro (les 2 pavés ci-dessus à
la suite), ca ne fonctionne pas : ca groupe les DO2 correctement mais pas les
DO1 (groupement mais de façon incorrect).

je n'arrive pas à comprendre pourquoi.

Peux-tu venir à ma rescousse une fois de plus s'il te plait ?


Merci encore

JF


Rebonjours à toi

Je ne sais pas si la suppression voir d'une manière plus générale
l'intervention sur les macros par code VBA est possible
J'ai moi même fais plusieurs tentatives sans succés
Je laisse les têtes pensantes de ce Forum s'il le souhaite s'exprimer sur ce
sujet

Par contre il est possible d'enregistrer ce code dans un document excel
propre et à partir de ton document de commander cette macro et de supprimer
ce document

Si cette solution te convient je peux t'aider à la mettre en place

Dis moi !!!


Bonjour FFO et encore une fois merci pour ce code !!

Ca marche nickel !!

J'ai une dernière question (enfin dernière pour l'instant ;-D ) :

Je souhaiterais à la fin de la macro que cette dernière s'auto-supprime et
propose automatiquement une "sauvegarde sous".

Est-ce que cela est possible ?

Slts

Jiffey




Salut jiffey
Tout dabord tu n'es en rien responsable de l'échange engendré par ton post
précédent je te rassure
Tu n'en as été que le catalyseur
cette mise au point aurais eu lieu trés certainement à une autre occasion si
tu n'étais pas passé par là

Ce préambule fait j'ai regardé ton code et je te propose de le corriger
comme celà :

Range("B65535").End(xlUp).Offset(0, 3).Select
Do While ActiveCell.Row > Range("B6").Row
Range(ActiveCell, ActiveCell.End(xlUp).Offset(1, 0)).EntireRow.Select
Selection.Rows.Group
If ActiveCell.Offset(-2, 4) = "" Then
ActiveCell.Offset(-2, 4).Select
Else
ActiveCell.Offset(-1, 4).End(xlUp).Offset(-1, 0).Select
End If
Loop
Je sais que je fais faire hurler les perfectionnistes de ce forum qui
n'apprécie pas la présence des "Select"

Certes ils alourdissent le fonctionnement de la Macro mais pour ton utilité
c'est à mon sens négligeable

Je reste ouvert à toute suggestion qui viserai à améliorer cette écriture
tout en concervant sa structure et notamment en supprimant ce mal aimé qui
est le "Select"

En tout état de cause ce bout de code s'inspirant de ta composition répond à
ton attente

Merci de me confirmer


Bonjour à tous,



Je fais suite au post qui a suscité tant de réactions (voir ma réponse dans
le post). J'espère n'avoir froissé personne et que quelqu'un pourra résoudre
mon nouveau problème...



j'ai un tableau http://cjoint.com/?hmjWGoxicV dans lequel je souhaterais
grouper les lignes limitées par DO2.


J'ai une macro mais elle fonctionne imparfaitement :


En effet, dans la colonne DO2, lorsque les cases pleines se suivent, le code
saute ces lignes (logique).
J'ai essayé avec une double condition, mais le pb, c'est que 3 "DO2" peuvent
se suivre, voire plus.

Bref, je n'y arrive pas. :-(( Mes connaissances sont trop faibles pour
résoudre ce pb.



























Avatar
FFO
Bonjours MichDenis

Interressé par ta procédure n'ayant jamais pu jusqu'à ce jour intervenir par
VBA sur un code quelconque j'ai réalisé un test avec ta proposition
J'ai toujours la même difficulté avec comme message d'erreur :

Soit un message m'indiquant que la source n'est pas fiable
Soit le message d'erreur 1004 : la méthode 'VBProject' de l'objet
'_Workbook' a échoué

As tu une idée sur le pourquoi du comment

Merci pour ton aide


Ceci détruit tout le code du classeur dans lequel la macro est écrite
Y compris la macro elle-même.

Sub test()

Dim Vbcomps As Object
Set Vbcomps = ThisWorkbook.VBProject.VBComponents
For Each vbcomp In Vbcomps
With vbcomp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Next

End Sub

Le hic à propos de cette procédure est si les modules sont vides
ils demeurent quand même présent....et tu continueras de recevoir
à l'ouverture de ce dernier le même à savoir si tu désires activer les
macros à cause de la présence des modules (même s'ils sont vides)

Pour tout supprimer, le te propose cette procédure :

'--------------------------------
Sub SupprimeToutCodeEtFormulaire()

Dim VBComp As Object
Dim VBComps As Object

Set VBComps =ThisWorkbook.VBProject.VBComponents

For Each VBComp In VBComps
Select Case VBComp.Type
Case 100
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Case Else
VBComps.Remove VBComp
End Select
Next VBComp

End Sub
'--------------------------------

Dernière remarque, si tu désires que ce soit les procédures d'un
classeur ouvert particulier que tu veux détruire, remplace dans chacune
des procédures proposées cette ligne de codde :

Set VBComps =ThisWorkbook.VBProject.VBComponents

Par

Set VBComps =Workbooks"(NomDuClasseur.xls").VBProject.VBComponents







Avatar
jps
bonjour FFO
j'ai cru comprendre que denis michon allait être absent du forum de longs
jours durant...
que son fan club se rassure : rien de grave si ce n'est des congés bien
mérités
j'espère que quelqu'un d'autre pourra te répondre
jps

"FFO" a écrit dans le message de news:

Bonjours MichDenis

Interressé par ta procédure n'ayant jamais pu jusqu'à ce jour intervenir
par
VBA sur un code quelconque j'ai réalisé un test avec ta proposition
J'ai toujours la même difficulté avec comme message d'erreur :

Soit un message m'indiquant que la source n'est pas fiable
Soit le message d'erreur 1004 : la méthode 'VBProject' de l'objet
'_Workbook' a échoué

As tu une idée sur le pourquoi du comment

Merci pour ton aide


Ceci détruit tout le code du classeur dans lequel la macro est écrite
Y compris la macro elle-même.

Sub test()

Dim Vbcomps As Object
Set Vbcomps = ThisWorkbook.VBProject.VBComponents
For Each vbcomp In Vbcomps
With vbcomp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Next

End Sub

Le hic à propos de cette procédure est si les modules sont vides
ils demeurent quand même présent....et tu continueras de recevoir
à l'ouverture de ce dernier le même à savoir si tu désires activer les
macros à cause de la présence des modules (même s'ils sont vides)

Pour tout supprimer, le te propose cette procédure :

'--------------------------------
Sub SupprimeToutCodeEtFormulaire()

Dim VBComp As Object
Dim VBComps As Object

Set VBComps =ThisWorkbook.VBProject.VBComponents

For Each VBComp In VBComps
Select Case VBComp.Type
Case 100
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Case Else
VBComps.Remove VBComp
End Select
Next VBComp

End Sub
'--------------------------------

Dernière remarque, si tu désires que ce soit les procédures d'un
classeur ouvert particulier que tu veux détruire, remplace dans chacune
des procédures proposées cette ligne de codde :

Set VBComps =ThisWorkbook.VBProject.VBComponents

Par

Set VBComps =Workbooks"(NomDuClasseur.xls").VBProject.VBComponents









Avatar
tissot.emmanuel
Bonjour,

Outils>Macros>Securite>Editeurs approuvés> Cocher "Faire confiance au projet
Visual Basic"

Cordialement,

Manu/

"FFO" a écrit dans le message de news:

Bonjours MichDenis

Interressé par ta procédure n'ayant jamais pu jusqu'à ce jour intervenir
par
VBA sur un code quelconque j'ai réalisé un test avec ta proposition
J'ai toujours la même difficulté avec comme message d'erreur :

Soit un message m'indiquant que la source n'est pas fiable
Soit le message d'erreur 1004 : la méthode 'VBProject' de l'objet
'_Workbook' a échoué

As tu une idée sur le pourquoi du comment

Merci pour ton aide


Ceci détruit tout le code du classeur dans lequel la macro est écrite
Y compris la macro elle-même.

Sub test()

Dim Vbcomps As Object
Set Vbcomps = ThisWorkbook.VBProject.VBComponents
For Each vbcomp In Vbcomps
With vbcomp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Next

End Sub

Le hic à propos de cette procédure est si les modules sont vides
ils demeurent quand même présent....et tu continueras de recevoir
à l'ouverture de ce dernier le même à savoir si tu désires activer les
macros à cause de la présence des modules (même s'ils sont vides)

Pour tout supprimer, le te propose cette procédure :

'--------------------------------
Sub SupprimeToutCodeEtFormulaire()

Dim VBComp As Object
Dim VBComps As Object

Set VBComps =ThisWorkbook.VBProject.VBComponents

For Each VBComp In VBComps
Select Case VBComp.Type
Case 100
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Case Else
VBComps.Remove VBComp
End Select
Next VBComp

End Sub
'--------------------------------

Dernière remarque, si tu désires que ce soit les procédures d'un
classeur ouvert particulier que tu veux détruire, remplace dans chacune
des procédures proposées cette ligne de codde :

Set VBComps =ThisWorkbook.VBProject.VBComponents

Par

Set VBComps =Workbooks"(NomDuClasseur.xls").VBProject.VBComponents









Avatar
FFO
Salut tissot

Mille mercis à toi j'accède enfin à ce secteur qui m'était interdit jusqu'à
lors
De nouvelles perspectives souvrent à moi

Que c'est beau de savoir !!!!!

Encore une fois Merci



Bonjour,

Outils>Macros>Securite>Editeurs approuvés> Cocher "Faire confiance au projet
Visual Basic"

Cordialement,

Manu/

"FFO" a écrit dans le message de news:

Bonjours MichDenis

Interressé par ta procédure n'ayant jamais pu jusqu'à ce jour intervenir
par
VBA sur un code quelconque j'ai réalisé un test avec ta proposition
J'ai toujours la même difficulté avec comme message d'erreur :

Soit un message m'indiquant que la source n'est pas fiable
Soit le message d'erreur 1004 : la méthode 'VBProject' de l'objet
'_Workbook' a échoué

As tu une idée sur le pourquoi du comment

Merci pour ton aide


Ceci détruit tout le code du classeur dans lequel la macro est écrite
Y compris la macro elle-même.

Sub test()

Dim Vbcomps As Object
Set Vbcomps = ThisWorkbook.VBProject.VBComponents
For Each vbcomp In Vbcomps
With vbcomp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Next

End Sub

Le hic à propos de cette procédure est si les modules sont vides
ils demeurent quand même présent....et tu continueras de recevoir
à l'ouverture de ce dernier le même à savoir si tu désires activer les
macros à cause de la présence des modules (même s'ils sont vides)

Pour tout supprimer, le te propose cette procédure :

'--------------------------------
Sub SupprimeToutCodeEtFormulaire()

Dim VBComp As Object
Dim VBComps As Object

Set VBComps =ThisWorkbook.VBProject.VBComponents

For Each VBComp In VBComps
Select Case VBComp.Type
Case 100
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Case Else
VBComps.Remove VBComp
End Select
Next VBComp

End Sub
'--------------------------------

Dernière remarque, si tu désires que ce soit les procédures d'un
classeur ouvert particulier que tu veux détruire, remplace dans chacune
des procédures proposées cette ligne de codde :

Set VBComps =ThisWorkbook.VBProject.VBComponents

Par

Set VBComps =Workbooks"(NomDuClasseur.xls").VBProject.VBComponents














1 2 3