Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel pour FFO (même si ça se fait pas dans un en-tête, désolé)

pour FFO (même si ça se fait pas dans un en-tête, désolé)

15 réponses
Avatar
Sunburn
Bonjour,
tout d'abord, les autres peuvent participer.... :°), ce sujet n'est pas fermé.
FFO m'avais fais une macro pour rajouter une ligne à la fin de tableaux, en
fonction de ma précédente demande. De plus, il y a un code pour réinitialiser
ces tableaux.
Est-il possible d'adapter les codes afin de l'appliquer à ce tableau
ci-joint ?
http://cjoint.com/?mdqMqAfCjA
Merci.
yann
---
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Offset(1, 0).Interior.ColorIndex = xlNone And
Target.Interior.ColorIndex = 36 And Cells(Target.Row, Target.Column) <> ""
Then
Formule1 = Range("D" & Target.Row + 1).Formula
Formule2 = Range("E" & Target.Row + 1).Formula
Target.EntireRow.Copy
Target.Offset(1, 0).EntireRow.Insert Shift:=xlDown
Target.Offset(1, 0).ClearContents
Target.Offset(-1, 0).EntireRow.Copy
Target.EntireRow.PasteSpecial Paste:=xlPasteFormats
Range("D" & Target.Row + 2).Formula = Split(Range("D" & Target.Row +
2).Formula, ":")(0) & ":" & Mid(Split(Range("D" & Target.Row + 2).Formula,
":")(1), 1, 1) & Mid(Split(Range("D" & Target.Row + 2).Formula, ":")(1), 2,
Len(Mid(Split(Range("D" & Target.Row + 2).Formula, ":")(1), 2)) - 1) + 1 & ")"
Range("E" & Target.Row + 2).Formula = Split(Range("E" & Target.Row +
2).Formula, ":")(0) & ":" & Mid(Split(Range("E" & Target.Row + 2).Formula,
":")(1), 1, 1) & Mid(Split(Range("E" & Target.Row + 2).Formula, ":")(1), 2,
Len(Mid(Split(Range("E" & Target.Row + 2).Formula, ":")(1), 2)) - 1) + 1 & ")"
End If
Application.CutCopyMode = False
End Sub
------
'nettoyage des feuilles à tableaux 60.21 et 90.31
Sub Nettoyage()
For j = 1 To Sheets.Count
If Sheets(j).Name = "60_21" Or Sheets(j).Name = "90_31" Then
Sheets(j).Activate
i = 0
Do While Range("A9").Offset(i, 0).Row < Range("D65535").End(xlUp).Row
If Range("A9").Offset(i, 0).Interior.ColorIndex = 36 Then
n = n + 1
End If
If Range("A9").Offset(i, 0).Interior.ColorIndex <> 36 Then
n = 0
End If
If n > 3 Then
Range("A9").Offset(i, 0).EntireRow.Select
Selection.Delete
i = i - 1
End If
i = i + 1
Loop
Range("A1").Activate
End If
Next
End Sub
------
Signaler un problème avec ce contenu

5 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2
Avatar
Sunburn
Je viens de tester...... et c'est nikel krome.
c'est tout pil poil ce que je voulais.

en effet, le projet était de grande ampleur, et il touche à sa fin... ouf,
mais c'est complexe, car je suis en phase de test "grandeur nature", et je
trouve des petits trucs par-ci et par-là, donc du temps et des reflexions.

merci de ton aide si précieuse, j'ai des tableaux de compet' avec ça.
Merci encore.
YANN

"FFO" a écrit :

Rebonjour à toi

Bon compte tenu de l'ampleur du projet qui de plus si je comprends bien
touche à sa fin tu es tout escusé

Pour cette petite ultime correction le nombre de lignes à conserver est
déterminé par la ligne :

If n > 3 Then

que tu dois mettre pour 12 lignes ainsi :

If n > 12 Then

Pour la formule de la colonne R j'ai rajouté au code cette ligne :

Range("R" & ActiveCell.Row).Formula = "=R" & ActiveCell.Row - 1

Ce qui donne au final ceci :

For j = 1 To Sheets.Count
If Sheets(j).Name = "60_21" Or Sheets(j).Name = "80_31" Then
Sheets(j).Activate
i = 0
Do While Range("A9").Offset(i, 0).Row < Range("A65535").End(xlUp).Row
If Range("A9").Offset(i, 1).Interior.ColorIndex = 36 Then
n = n + 1
End If
If Range("A9").Offset(i, 1).Interior.ColorIndex <> 36 Then
n = 0
End If
If n > 12 Then
Range("A9").Offset(i, 0).EntireRow.Select
Selection.Delete
Range("R" & ActiveCell.Row).Formula = "=R" & ActiveCell.Row - 1
i = i - 1
End If
i = i + 1
Loop
Range("A1").Activate
End If
Celà devrait convenir

Sur ce lien peut être la dernière mouture :

http://www.cijoint.fr/cjlink.php?file=cj200812/cijh3snRlp.xls

Fais des essais et dis moi !!!



Avatar
Sunburn
re,
finalement, j'ai modifié la macro comme cela, car le test doit se faire à
partir de A12 et non de A9,non ?
et les feuilles, j'ai que la 80_31.
mes autres feuilles (60_21 et 90_31) de la demande originale de l'autre
jour, les nettoyages sont gérés par des macros séparées, chaque "nettoyage" à
sa macro..... comme ça, pas de jaloux.
voilà, ci-joint le code, je crois pas que j'ai zappé un truc à modifié.
YANN
----
Sub Tableau_80_31()
For j = 1 To Sheets.Count
If Sheets(j).Name = "80_31" Then
Sheets(j).Activate
i = 0
Do While Range("A12").Offset(i, 0).Row < Range("A65535").End(xlUp).Row
If Range("A12").Offset(i, 1).Interior.ColorIndex = 36 Then
n = n + 1
End If
If Range("A12").Offset(i, 1).Interior.ColorIndex <> 36 Then
n = 0
End If
If n > 12 Then
Range("A12").Offset(i, 0).EntireRow.Select
Selection.Delete
Range("R" & ActiveCell.Row).Formula = "=R" & ActiveCell.Row - 1
i = i - 1
End If
i = i + 1
Loop
Range("A1").Activate
End If
Next
End Sub
----
Avatar
Sunburn
je me confirme après test : ça marche ... Yeah !!

"Sunburn" a écrit :

re,
finalement, j'ai modifié la macro comme cela, car le test doit se faire à
partir de A12 et non de A9,non ?
et les feuilles, j'ai que la 80_31.
mes autres feuilles (60_21 et 90_31) de la demande originale de l'autre
jour, les nettoyages sont gérés par des macros séparées, chaque "nettoyage" à
sa macro..... comme ça, pas de jaloux.
voilà, ci-joint le code, je crois pas que j'ai zappé un truc à modifié.
YANN
----
Sub Tableau_80_31()
For j = 1 To Sheets.Count
If Sheets(j).Name = "80_31" Then
Sheets(j).Activate
i = 0
Do While Range("A12").Offset(i, 0).Row < Range("A65535").End(xlUp).Row
If Range("A12").Offset(i, 1).Interior.ColorIndex = 36 Then
n = n + 1
End If
If Range("A12").Offset(i, 1).Interior.ColorIndex <> 36 Then
n = 0
End If
If n > 12 Then
Range("A12").Offset(i, 0).EntireRow.Select
Selection.Delete
Range("R" & ActiveCell.Row).Formula = "=R" & ActiveCell.Row - 1
i = i - 1
End If
i = i + 1
Loop
Range("A1").Activate
End If
Next
End Sub
----



Avatar
FFO
Rebonjour à toi

Aucune importance le test peux démarrer même en A1 pourvu que les cellules
rencontrées de couleur jaune déterminé par la ligne :

If Range("A12").Offset(i, 1).Interior.ColorIndex = 36

et la ligne

If Range("A12").Offset(i, 1).Interior.ColorIndex <> 36 Then

Qui veux dire la cellule A12 (Range("A12")) décalé de 1 à droite (Offset(i,
1).) et décalé dessous du nombre représenté par la variable "i"
en d'autre terme toute les cellules de la colonne B à concurrence du maximun
que peut être "i"

Ces cellules en jaune donc doivent être exclusivement celles du tableau

Si tu n'as pas utilisé cette couleur en dehors des tableaux le test peux
trés bien démarrer en A1

Quand je dit la couleur jaune c'est celle que tu as utilisé les autres
jaunes n'étant pas concernés

Voilà pour les explications

Au plaisir de t'épauler une prochaine fois !!!!
Avatar
Sunburn
Ok, je comprend un peu mieux maintenant.
et j'ai mis en A12, car en effet, sur toutes mes feuilles, j'ai en A4 une
cellule jaune.
et là en l'espèce, j'ai une cellule jaune aussi en F10, donc j'ai bien fait
de mettre A12 !!!!
Par contre, j'avais une cellule A48 aussi qui est jaune.......
je vais en changer la couleur, ça ser plus simple, je viens de voir qu'elle
a été supprimée lors du "nettoyage" (j'avais pas fais gaffe, j'avais regardé
que le tableau.....)

merci.
YANN


"FFO" a écrit :

Rebonjour à toi

Aucune importance le test peux démarrer même en A1 pourvu que les cellules
rencontrées de couleur jaune déterminé par la ligne :

If Range("A12").Offset(i, 1).Interior.ColorIndex = 36

et la ligne

If Range("A12").Offset(i, 1).Interior.ColorIndex <> 36 Then

Qui veux dire la cellule A12 (Range("A12")) décalé de 1 à droite (Offset(i,
1).) et décalé dessous du nombre représenté par la variable "i"
en d'autre terme toute les cellules de la colonne B à concurrence du maximun
que peut être "i"

Ces cellules en jaune donc doivent être exclusivement celles du tableau

Si tu n'as pas utilisé cette couleur en dehors des tableaux le test peux
trés bien démarrer en A1

Quand je dit la couleur jaune c'est celle que tu as utilisé les autres
jaunes n'étant pas concernés

Voilà pour les explications

Au plaisir de t'épauler une prochaine fois !!!!



1 2