XL 2010 [Résolu] Insertion ligne + incrémentation vba

Spinzi

XLDnaute Impliqué
Bonjour Bonjour,


J'aurai besoin que dans la colonne "Action", le texte "Action" s'incrémente des valeurs présentes en colonne A. J'aurai voulu que cela soit fait directement en VBA mais pour l'instant je vais le traiter avec une colonne supplémentaire.

J'ai la macro Insérer ligne qui copie colle la ligne d'au dessus et une macro double clique qui vérifie la présence d'un X en colonne D pour afficher "Action 1:" en colonne E

Merci d'avance
Spinzi
 

Pièces jointes

  • Test ajout actions vIP 2.xlsm
    26.5 KB · Affichages: 41
Dernière édition:

Spinzi

XLDnaute Impliqué
Bonjour Philippe,

merci pour ton retour.
Ca ne correspond pas à mon besoin : en fait dans la colonne "Action" il doit y avoir un remplissage manuel après le "Action 1/2/..." donc ca écraserait la formule. C'est ce pourquoi je voudrais passer par une macro.

Un fichier de ce que j'attends avec des formules ci joint.

Les problèmes que je rencontre c'est d'incrémenter un numéro après "Action " en fonction du nombre d'occurrence de cette ligne (colonne C) grâce à une macro.

Spinzi
 

Pièces jointes

  • Test ajout actions vIP 3.xlsm
    26.8 KB · Affichages: 31

youky(BJ)

XLDnaute Barbatruc
Hello,
sans doute comme ceci
une seule ligne de modifiée
Bruno
VB:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Application.ScreenUpdating = 0
If Not Intersect(Target, Range("D10:D100")) Is Nothing Then
Target.Value = IIf(Target.Value = "", "X", "")
    If Target.Value = "X" Then
    Target.Offset(0, 1).Value = "Action " & Application.CountIf(Range(Cells(11, 3), Cells(Target.Row, 3)), Cells(Target.Row, 3)) & " :"
    Else: Target.Offset(0, 1).Value = ""
    End If
End If
Application.ScreenUpdating = 1
End Sub
 

Spinzi

XLDnaute Impliqué
Bonsoir youky(B),

merci pour ta proposition !
Je me suis empressé de la tester et elle fonctionne presque comme je le souhaiterais :
Lors du remplissage avec le double clic ca fonctionne correctement.
Mais c'est lors de l'ajout de ligne que j'aimerai que cela s'incrémente. Mais je crois que le code que j'ai trouvé ne fait que copier la ligne telle quelle.

Désolé j'ai mal défini ce que je souhaitais

Dans l'exemple un exemple sur 4 lignes :
_les 2 premieres en rouge actuellement
_les 2 dernieres en bleu de ce que j'aimerais

Encore merci !

Spinzi
 

Pièces jointes

  • Test ajout actions vIP 4.xlsm
    27.7 KB · Affichages: 25

youky(BJ)

XLDnaute Barbatruc
Bonjour,
Voici,
Par contre si on efface un X avec Action 1 et qu'on remet le X le 1 passera avec le N° x-fois
Bruno
VB:
Sub InsererLigne()
'// On bloque le rafraichissement de l'écran
Application.ScreenUpdating = 0
ActiveCell(1).EntireRow.Insert
ActiveCell.Offset(1, 0).EntireRow.Copy Cells(ActiveCell.Row, 1)
Cells(ActiveCell.Row, 5) = "Action " & Application.CountIf([C3:C500], Cells(ActiveCell.Row, 3)) & ":"
'// On débloque le rafraichissement de l'écran
Application.ScreenUpdating = 1
End Sub
 

Spinzi

XLDnaute Impliqué
Bonjour Bonjour !

Super pour le code.
En l'essayant je me rends compte que l'incrémentation se fait dans le mauvais sens comme si la ligne était insérer en dessous (cf fichier joint : en rouge ce que j'obtiens en bleu ce que je souhaiterais).

Etant vraiment novice en VBA (j'ai utilisé des codes trouvés sur la toile), j'ai beaucoup de mal à comprendre comment agissent et réagissent les lignes de ma macro InsererLigne (alors qu'il n'y a pas beaucoup de lignes !).

D'ailleurs si des choses sont optimisables dans mes différentes macro, je suis preneur.

En tous cas merci pour votre temps !

Spinzi
 

Pièces jointes

  • Test ajout actions vIP 5.xlsm
    28 KB · Affichages: 27

youky(BJ)

XLDnaute Barbatruc
Voici la ligne cette fois est en dessous de la ligne sélectionnée
Attention une seule cellule doit être sélectionnée
Bruno
VB:
Sub InsererLigne()
If Selection.Count > 1 Then Exit Sub 'on quitte si plusieurs selection
lig = Selection.Row + 1
Rows(lig).Insert
Rows(lig - 1).Copy Cells(lig, 1)
Cells(lig, 5) = "Action " & Application.CountIf([C3:C500], Cells(lig, 3)) & ":"
Cells(lig, 3).Select
End Sub
 

Discussions similaires

Réponses
8
Affichages
320

Statistiques des forums

Discussions
311 720
Messages
2 081 925
Membres
101 841
dernier inscrit
ferid87