Discussion :

[charben]

Bonjour à tous. Je suis débutant en VBA.
Je vous envoie un fragment de fichier de planification pour lequel je voudrais mettre le code des tâches (colonne A) sous les lignes de façon automatique car le fichier réel renferme un nombre important de lignes similaires.
Les tâches sont identifiées par les lignes dont la colonne C est vide
J'ai imaginé l'algorithme suivant:
Si la cellule CX est non vide copy la cellule AX de la même ligne et colle dans AX+1 et concaténer avec ".1"
Incrémente ensuite .2; .3; ... tant que la cellule "C" de la même ligne est vide, jusqu'à rencontrer une cellule non vide de la colonne A
Si tu rencontres une cellule non vide dans la colonne A, Copie la cellule; décale d'une ligne vers le bas, Colle et concaténer avec ".1"
Incrémente ensuite .2; .3 .... tant que la cellule "C" de la même ligne est vide, jusqu'à rencontrer une cellule non vide de la colonne A

Arrête lorsque tu rencontres la cellule qui contient "Total" .

J'ai joint le fichier initial (fichier planning) et le résultat que je souhaite avoir( fichier résultat)
J'ai commencé ceci mais la phase pour incrémenter m'est difficile car je ne sais pas indiquer comment s'arrêter si la cellule n'est pas vide et reprendre.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub incrémentercode()
Sheets (feuil1).Select 
Dim i As Integer
Do While Not IsEmpty(Cells(i, 3))
    Cells(i, 1).Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Select
 
  Cells(i + 1, 1).Select
 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Cells(i + 1, 1) = Cells(i + 1, 1) & ".1"
 
Loop
    Do While IsEmpty (Cells(i, 3))
    Cells(i, 1).Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Select
 
 
Loop
End Sub

Si quelqu'un peut m'aider je suis preneur. Merci d'avance.

[EricDgn]

Bonjour,

Une façon de faire cela:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Option Explicit
 
Sub Incrementer()
   Dim kR As Long, sCode As String, k As Long
   kR = 1                           '--- n° ligne
   While Cells(kR, 2) <> ""         '--- tant qu'il y a quelque chose en cellule de colonne 2 = B
      If Cells(kR, 1) > "" Then
         '--- cellule en colonne 1 = A n'est pas vide >>> réinitialise
         k = 0
         sCode = Cells(kR, 1)
      Else
         '--- cellule en colonne 1 = A est vide >>> incrémente
         k = k + 1
         Cells(kR, 1) = sCode & "." & k
      End If
      kR = kR + 1
   Wend
End Sub

Bonne continuation.

[charben]

Merci beaucoup pour l'appui M.EricDgn.
J'ai essayé mais, je ne vois que la première ligne générée.
Peux tu m'aider davantage?

[EricDgn]

Bonjour,
Chez moi cela fonctionne avec le fichier exemple attaché au premier message.
Bien comprendre que c'est la colonne B qui détermine quand le calcul s'arrête: cellule vide => fin
Enfin, un fichier contenant des macros doit être sauvé sous le format .xlsm
Cordialement

[MarcelG]

Bonjour et bienvenu sur ce Forum,

Pas de fichier joint lors du 1er post. C'est une règle.

3 remarques
- la variable i n'est ni initialisée, ni alimentée (aucune incrémentation)
- Ces f... Select ne servent à rien
- les objets Cells ne sont pas rattachés à la feuille Parent

Quant au code.
Eviter ce genre de ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Do While Not IsEmpty(Cells(i, 3))

Balayer plutôt les Cellules Spéciales vides ou avec constante.