do loop

[vatounet]

salut,

j'ai un code pas fini comme ça(au passage ou est la fonction pour inserer mon code dans une jolie case) :

Sub activ1()

Dim i As Long
Dim x As Long
Sheets(1).Select
i = 2
Cells(i, 1).Activate
x = 1
Do
If ActiveCell.Value = ActiveCell.Offset(x, 0).Value Then
x = x + 1
Loop While ActiveCell.Value <> ActiveCell.Offset(x, 0).Value
Else: Range(ActiveCell, ActiveCell.Offset(x, 0)).Select
Selection.Copy
End If
End Sub

Et un message d'erreur (normal) qui me dit fonction loop sans do !

J'essai d'avoir le fonctionnement suivant
si valeur de la cellule active = valeur de la cellule en dessous
alors compare
valeur de la cellule active avec valeur de la cellule 2 ligne en dessous
puis idem 3, 4, 5 ...lignes en dessous
jusqu'a ce que valeur de la cellule active soit differente de valeur de la cellule X ligne en dessous

incredible isn't it !

Bonne soirée

Fred

 

[titcoeur]

salut vatounet,

Est-ce que ceci ne suffirait pas ?

Sub activ1()

Dim i As Long
Dim x As Long
Sheets(1).Select
i = 2
Cells(i, 1).Activate
x = 1
    Do While ActiveCell.Value = ActiveCell.Offset(x, 0).Value
        x = x + 1
    Loop
        Range(ActiveCell, ActiveCell.Offset(x, 0)).Select
            
End Sub

Rem : pour mettre le code dans un cadre de couleur, tu le sélectionnes, puis tu appuies sur code dans les formattage (B/i/ ...)
sous le nom du sujet et les smileys.

 

[vatounet]

Salut TICOEUR

c'est tellement simple quand ça marche

Merci beaucoup,

je continue donc ma boucle, je crois qu'il en faut une deuxieme pour toute les valeurs de ma colonne (faut que je deplace l'activecell au fur et a mesure)

A+

et merci encore

Fred

 

[vatounet]

Oh excuse moi j'ai mal orthographié ton speudo
TITCOEUR

 

[vatounet]

Re salut,
J'insiste...

Maintenant j'ai un code comme ça, mais soit la boucle tourne dans le vide et ne s'arréte pas, soit il ne se passe rien.

je crois qu'elle tourne dans le vide uniquement lorsque j'écrit DO seul (= sans until ou while ...)

Sub activ3()

Dim i As Long
Dim x As Long
Sheets(1).Select
i = 2
x = 1
Do Until ActiveCell.Value = 0
Cells(i, 1).Activate
    Do While ActiveCell.Value = ActiveCell.Offset(x, 0).Value
        x = x + 1
    Loop
    Range(ActiveCell, ActiveCell.Offset(x - 1, 0)).EntireRow.Select
    Selection.Copy
    Sheets(2).Activate
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.Delete
i = x
Loop

End Sub

si vous avez une solution, même une micro solution toute petite, se sera deja enorme

A+

Fred

 

[titcoeur]

salut vatounet

je pense que le x est réinitialisé au mauvais endroit et i mal incrémenté.

Sub activ3()

Dim i As Long
Dim x As Long
Sheets(1).Select
i = 2

Do Until Cells(i, 1).Value = 0
Cells(i, 1).Activate
    x = 1
    Do While ActiveCell.Value = ActiveCell.Offset(x, 0).Value
        x = x + 1
    Loop
    Range(ActiveCell, ActiveCell.Offset(x - 1, 0)).EntireRow.Select
    Selection.Copy
    Sheets(2).Activate
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.Delete
i = i + 1

Loop

End Sub

Je n'ai pas l'habitude avec les do until
mais je suppose que c'est idem que
do while Cells(i, 1).Value <> 0.
Fais gaffe qu'il y ait bien des zéros à un moment donné sinon, ça nr s'arrête pas.
C'est peut-être plus prudent de mettre
do while Cells(i, 1).Value <> 0 and Cells(i, 1).Value <> ''

A+