Loop sans Fin

Bonjour

j'avais écrit en tâtonnant cette routine.

elle ne marche plus... et tourne en boucle.

pouvez-vous m'expliquez pourquoi?

Merci à vous.

Sub MIXTE2Bal() 'procédure MIXTE dédoublement de lignes

Dim O_Cell As Object

Dim C_UI As String

Dim i, j As Integer

Dim o As Integer

Dim DL As Integer 'déclare la variable DL (Dernière Ligne)

'Application.ScreenUpdating = False

DL = ActiveSheet.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet F1

For o = 1 To DL 'mise en place du loop

C_UI = "MIXTE" 'valeur à chercher

ActiveSheet.UsedRange.Rows("2:" & ActiveSheet.UsedRange.Rows.Count).Select 'prend le tableau sans les entêtes

'Application.Goto Reference:="UI" ' "UI" est le nom de la zone de recherche

Set O_Cell = Selection.Find(C_UI) ' recherche de la valeur

If Not O_Cell Is Nothing Then 'si l'objet O_Cell contient les coordonnées de la cellule

'MsgBox "J'ai trouvé" 'message affiché

O_Cell.Select ' sélection de la cellule

'copier coller de la ligne du dessus

vlig = ActiveCell.Row

vzona = vlig & ":" & vlig

vzonb = vlig + 1 & ":" & vlig + 1 'dessous sinon avec - c'est dessus

Selection.EntireRow.Select

Selection.Insert Shift:=xlDown

Rows(vzonb).Select

Selection.Copy

Rows(vzona).Select

ActiveSheet.Paste

Cells(vlig, 1).Select

Application.CutCopyMode = False 'déselectionner ligne

'repositionne la selection

Cells(ActiveCell.Row, 1).Select

'décale la selection 1

ActiveCell.Offset(0, 5).Select

'changer la valeur MIXTE en RECETTES

ActiveCell.Value = "RECETTES"

'décale la selection 2

ActiveCell.Offset(1, 0).Select

'changer la valeur MIXTE en RECETTES

ActiveCell.Value = "DEPENSES"

'Vider Case Recettes - décale la selection et vide

ActiveCell.Offset(0, 4).Select

ActiveCell.Value = 0

'Vider Case Depenses - décale la selection et vide

ActiveCell.Offset(-1, -1).Select

ActiveCell.Value = 0

End If

Next o 'fin du loop

'Application.ScreenUpdating = True

End Sub

Bonjour,

c'est illisible. Utilise l'icone </> pour mettre en forme ton code et garder l'indentation.

Et décris ce qu'elle est sensée faire, ça aidera ceux qui voudront s'y pencher.

eric

Bonjour

Ta macro ne tourne pas en boucle sans fin. Elle est simplement très lente. Pour t'en convaincre, mets cette instruction juste avant "End Sub" et sois patient :

MsgBox "Travail terminé"

Tu aurais intérêt à l'optimiser en évitant les instruction de type "....Select" et "Selection...."

Bye !

Bonjour à tous,

Un essai beaucoup plus rapide ...

- si le mot "MIXTE" est toujours en colonne F ...

Sub MIXTE2Bal()      'procédure MIXTE dédoublement de lignes

Dim O_Cell As Object
Dim C_UI As String
Dim i, j As Integer
Dim o As Integer
Dim DL As Integer      'déclare la variable DL (Dernière Ligne)
Dim C
   'Application.ScreenUpdating = False

DL = ActiveSheet.Cells(Application.Rows.Count, "A").End(xlUp).Row      'définit la dernière ligne éditée DL de la colonne A de l'onglet F1

   With ActiveSheet.Range("F2:F" & DL)
      C_UI = "MIXTE"      'valeur à chercher
      Set C = .Find(C_UI, LookIn:=xlValues, LookAt:=xlWhole) ''' ou xlPart
      If Not C Is Nothing Then
         firstAddress = C.Address
         Do
            vlig = C.Row      ' détermine la ligne
            vcol = C.Column      ' détermine la colonne
            vzona = vlig & ":" & vlig      ' détermine ZoneA
            vzonb = vlig + 1 & ":" & vlig + 1      ' détermine Zone B en dessous sinon avec - c'est dessus
            Rows(vzona).EntireRow.Insert Shift:=xlDown      ' insère une ligne
            Rows(vzonb).Copy Rows(vzona)      ' copie la ligne de la ZoneB en ligne de la ZoneA
            Cells(vlig, vcol).Value = "RECETTES"      ' remplace texte
            Cells(vlig + 1, vcol).Value = "DEPENSES"      ' remplace texte
            Cells(vlig + 1, vcol + 4).Value = 0      ' cellule à 0
            Cells(vlig, vcol + 3).Value = 0      ' cellule à 0

            Set C = .FindNext(C)
            If C Is Nothing Then
               GoTo DoneFinding
            End If
         Loop While C.Address <> firstAddress
      End If
DoneFinding:

      .Cells(1, 1).Select
   End With
   'Application.ScreenUpdating = True
End Sub

ric

Merci à tous.

Vous êtes des Génies, et Ric c'est dieu

Il faut un bon processeur, mais ça marche nickel.

Re,

.Find(C_UI, LookIn:=xlValues)

il faudrait ajouter le paramètre lookat:=xlWhole ou xlPart

A faire systématiquement sinon on se retrouve avec les paramètres de la dernière recherche utilisateur qui ne correspond pas forcément à ce qu'on veut (tout ou partie du texte).

eric