Ajouter automatiquement une incrémentation à droite d'une valeur collée

Version imprimable

22/12/2010, 21h58
abdel792

Ajouter automatiquement une incrémentation à droite d'une valeur collée

Bonsoir,

Voilà, j'ai un classeur créé avec Excel 2007.

Dans la première ligne, de B1 à XFD1, j'ai une suite de dates, allant du premier janvier 2010 au 8 novembre 2054.

Dans la première colonne, de A2 à A26, j'ai une suite d'horaires.

La première colonne est figée, c'est-à-dire qu'elle reste affichée lorsque je me déplace vers la droite.

Je souhaiterais, à chaque fois que je colle une valeur qui est déjà présente dans la ligne courante, qu'une incrémentation s'ajoute automatiquement juste à droite de la valeur collée.

En d'autres termes, si dans B2 par exemple, DUPONT est déjà présent, lorsque je vais le coller dans une autre cellule dans la même ligne, ça me mette DUPONT 1 puis DUPONT 2, ainsi de suite de façon automatique.

Serait-ce possible avec l'aide d'une procédure ou d'une fonction VBA?

Je vous remercie d'avance si vous avez une réponse.

Une première approximation

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub Worksheet_Change(ByVal Target As Range)
Dim indx As Integer
 
If Not Intersect(Target, Range("B2:XFD26")) Is Nothing Then
     If Target.Count = 1 Then
          indx = Application.CountIf(Range("B" & Target.Row & ":XFD" & Target.Row), Target.Value & "*") - 1
          If indx > 0 Then
               Application.EnableEvents = False
               Target.Value = Target.Value & indx
               Application.EnableEvents = True
          End If
     End If
End If
End Sub

Salut
Arff je me fait vieux...
Bon je met quand même mon code il est commenté ;)
Mon code est très similaire a celui de Mercadog. Le seul inconvénient de cette méthode est qu'elle ne mettra pas a jour les indices numeriques si tu rajoutes un nom avant une cellule portant déjà ce nom. Exemple cellule E12 = Dupont 3, si tu mets Dupont en cellule D12 la cellule D12 sera changée en Dupont 3, mais la cellule E12 restera tel quelle (Dupont 3).
[Edit]
Il est similaire mais pas tout a fait identique. Mercatog teste la ligne complète, dans le cas précédent tu auras donc avec son code
E12=Dupont 3 et D12 = Dupont 4.
A tois de voir le fonctionnement que tu souhaites obtenir.
[/Edit]

Reste à savoir ce que tu recherches exactement, une petite remarque tout de même sur ta demande, 2054 ... je serais en retraite depuis un baille, travailler sur de tels volumes de données me parait excessif, je ne connais pas ta problématique de départ, mais les outils changent et évoluent rapidement, ton programme sera t il encore utilisé dans 5 ou 10 ans?

Pour des questions de facilité de mise en place le code de Mercatog est bien plus adapté que le mien, je te conseille donc d'utiliser le sien, comme dit plus haut j'ai commenté le mien ... si des fois tu voulais comprendre ce que tu fais, ouais je sais que ça se perd...

Ce code est à mettre dans la section Change de ta feuille
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 Private Sub Worksheet_Change(ByVal Target As Range) Dim NbrNom As Integer 'On regarde si on est dans le bon interval de cellules If Not Intersect(Target, Range("C2:XFD26")) Is Nothing Then 'On regarde a partir de la 3eme colonne, pas de doublon possible avant 'On regarde combien de fois ce nom apparait NbrNom = Dupont(Target) 'Si il n'apparait jamais on ne fait rien, sinon... If NbrNom <> 0 Then '... on note cette indice à la suite de notre texte fraichement rajouté 'Pour ce faire on bloque les evenements, pour éviter de rappeler Change lors de la modif de la cellule Application.EnableEvents = False 'On change le texte Target = Target & " " & CStr(NbrNom) 'On reactive les evenements Application.EnableEvents = True End If End If End Sub
Celui ci dans un module
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 Function Dupont(Target As Range) As Integer Dim InterRange As Range 'On defini l'intervalle sur lequel on va travailler 'On travail de la colonne B à la colonne contenant Target - 1 colonne Set InterRange = Target.Worksheet.Range(Target.Worksheet.Cells(Target.Row, "B"), Target.Offset(0, -1)) 'On regarde combien de fois apparait le nom recherché Dupont = WorksheetFunction.CountIf(InterRange, Target & "*") End Function
Bonne nuit
Qwaz

23/12/2010, 07h37
abdel792

Salut tous,

En fait, le code de Mercatog est bon, inséré dans la section Worksheet, sous-section Change, il incrémente bien les valeurs.

Cependant, y aurait t-il un moyen de faire en sorte qu'à la copie, le chiffre ou le nombre incrémenté ne soit pas ignoré.

Je m'explique :

Si je colle la valeur DUPONT de B3 vers E3, ça incrémente bien, ça va me mettre DUPONT 1.

Mais si je copie E3 dans G3, ça me mettra DUPONT 11.

Autre chose, je souhaiterais que la première valeur d'incrémentation ne soit pas DUPONT 1 mais DUPONT 2, ainsi le premier DUPONT sera pris en compte.

Qwazerty, en fait, ce projet m'a été demandé par un ami qui est médecin Kyné, il souhaiterait créer une application Excel pour gérer ses rendez-vous.

En premier, le projet avait été créé dans Excel 2003, mais ça ne lui convenait pas, le nombre de colonnes de chaque feuilles étant de 256 colonnes seulement.

C'est pour cela qu'il a préféré Excel 2007, ca lui fait un total de 16000 colonnes, soit 43 ans de travail !

Bien sûr, ces 43 ans seront revus à la baisse à la fin de sa carrière professionnelle, c'est juste pour qu'il est un aperçu général sur toutes les consultations qu'il a fait, lui évitant ainsi de créer plusieurs classeurs.

Voili voilou, tu sais tout maintenant.

Rebonjour,

J'essaie de décortiquer les codes que vous m'avez communiqué, je ne comprends pas le code suivant de Qwazerty.

Pourtant, les commentaires sont bien là, mais je suis débutant dans le domaine.

Quelqu'un pourrait t-il m'expliquer la signification du code suivant?

Il figure dans la fonction Dupont que m'a communiqué Qwazerty que je remercie au passage.
Code:

1 2 3 'On defini l'intervalle sur lequel on va travailler 'On travail de la colonne B à la colonne contenant Target - 1 colonne Set InterRange = Target.Worksheet.Range(Target.Worksheet.Cells(Target.Row, "B"), Target.Offset(0, -1))
En fait, finalement, je souhaite alléger le code, mais je n'arrive pas à trouver comment faire.

Je m'explique, j'espère que je serais assez claire.

Si par exemple je copie une cellule qui comporte Dupont(1), je veux qu'elle se transforme en Dupont (2) à l'emplacement où je la collerai, quel que soit cet endroit.

Pour le premier numéro, je peux l'écrire manuellement, il n'y a pas de problème.

Mais c'est lorsque je copierai cette valeur comportant ce numéro 1 dans une autre cellule que je souhaite que le 1 se transforme en 2, toujours entre parenthèses.

Ensuite, si je copie le Dupont(2), je souhaiterai qu'il se transforme en Dupont(3) dans la cellule où je l'ai collé, ainsi de suite.

Pour moi, ce serait plus simple que je copie colle la valeur la plus récente plutôt que de rechercher la valeur la plus éloignée.

De plus, cette procédure ne requiert pas que l'on fasse le calcul du nombre d'occurences figurant dans l'intervale dans laquelle nous allons travailler.

Quelqu'un pourrait t-il m'envoyer ne serait ce qu'un début de code afin que je puisse essayer?

Je vous remercie d'avance et je vous souhaite de joyeuses fêtes à tous.

25/12/2010, 19h32
Invité

Bonsoir,

En fait avec la précision que vous venez d'apporter :

Citation:

Ensuite, si je copie le Dupont(2), je souhaiterai qu'il se transforme en Dupont(3) dans la cellule où je l'ai collé, ainsi de suite.

ce n'est plus tout à fait la même chose que votre demande d'origine qui a généré les réponses que vous avez obtenues.

En effet, il est facile d'incrémenter de "1" le nom contenu dans la cellule que vous voulez copier/coller et même bien plus facile que de faire ce que vous demandiez au départ, le problème est de savoir ensuite ce qui se passe si vous faites un copier/coller d'une cellule contenant "Dupont(2)" alors que "Dupont(3)" existe déjà ?
25/12/2010, 21h03
abdel792

Bonsoir,

Oui, je m'excuse d'ailleurs d'avoir provoqué ce petit malentendu.

En fait, après réflexion, je pense que ma seconde demande répond beaucoup mieux à m'on attente.

Pour le Dupont(3), même si une autre cellule comportant cette valeur est présente dans le tableau, je ne pense pas que ça pourra causé un quelconque problème, la procédure que je cherche à réaliser ne se contente que d'incrémenter ce qui a été copié, sans vérification de la présence de cette valeur dans le tableau.

Cependant, pour la réinitialisation du compteur, c'est à dire la remise à 1, je le ferai manuellement selon le contexte.

Une autre proposition qui ne gère pas les suppressions

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Private Sub Worksheet_Change(ByVal Target As Range)
Dim plage As Range, c As Range
Dim LeMot As String
Dim indx As Integer, Suff As Integer
 
If Target.Count = 1 Then
     If Target.Value <> "" Then
          LeMot = Target.Value
          Suff = InStr(LeMot, "(")
          If Suff > 0 Then LeMot = Left(LeMot, Suff - 1)
          Set plage = Range(Cells(Target.Row, 2), Cells(Target.Row, 255))
          If Application.CountIf(plage, LeMot & "*") > 1 Then
               Application.EnableEvents = False
               For Each c In plage.SpecialCells(xlCellTypeConstants)
                    If InStr(c.Value, LeMot) Then
                         c.Value = LeMot & IIf(indx > 0, "(" & indx & ")", "")
                         indx = indx + 1
                    End If
               Next c
               Application.EnableEvents = True
          End If
     End If
End If
End Sub

Bonsoir,

Je tenais à vous remercier tous pour votre aide précieuse.

Mercatog, le code que tu m'as envoyé fait bien le travail, cependant, si j'écris Dupont(1) dans une cellule quelconque, je trouve Dupont tout court dedans.

Ensuite, je dois copier ce Dupont pour généré le Dupont(1).

Hors, mon souhait était d'écrire le premier Dupont(1) manuellement, et de ne copier que les valeurs incrémentés, pour que ça se transforme en dupont((2), Dupont(3), etc.

Pour ce faire, j'ai pu créer un petit code qui me donne entière satisfaction, je vous le soumet ci-dessous.

J'écris Dupont dans une cellule quelconque, le code me le transforme automatiquement en Dupont(1).

Ensuite, si je copie ce Dupont(1) ainsi généré, j'ai bien le Dupont(2), etc.

Je ne vérifie pas l'intervale de cellule, car ça n'a aucune importance dans ce cas bien précis.

Vous voici le code, en vous renouvelant tous mes remerciements.

PS :

Pour le blocage des événements, je l'ai peut-être fait un peu trop tôt, mais le code fonctionne à merveille chez moi, et ne provoque aucune erreur.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 Private Sub Worksheet_Change(ByVal Target As Range) Dim LeMot As String, Plus As String Dim indx As Integer, Suff As Integer If Target.Count = 1 Then Application.EnableEvents = False If Target.Value <> "" Then LeMot = Target.Value Suff = InStr(LeMot, "(") If Suff = 0 Then indx = 1 Target.Value = LeMot & "(" & indx & ")" Else Plus = Right(LeMot, Len(LeMot) - Suff) Plus = Left(Plus, Len(Plus) - 1) indx = CInt(Plus) indx = indx + 1 LeMot = Left(LeMot, Suff - 1) Target.Value = LeMot & "(" & indx & ")" End If Application.EnableEvents = True End If End If End Sub
Amicalement.

Ce code écrit le mot avec un suffixe qui s'incrémente et mets à jours tous les mots en partant de la gauche vers la droite

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Private Sub Worksheet_Change(ByVal Target As Range)
Dim plage As Range, c As Range
Dim LeMot As String
Dim indx As Integer, Suff As Integer
 
If Target.Count = 1 Then
     If Target.Value <> "" Then
          LeMot = Target.Value
          Suff = InStr(LeMot, "(")
          If Suff > 0 Then LeMot = Left(LeMot, Suff - 1)
          Set plage = Range(Cells(Target.Row, 2), Cells(Target.Row, 255))
          If Application.CountIf(plage, LeMot & "*") > 1 Then
               Application.EnableEvents = False
               For Each c In plage.SpecialCells(xlCellTypeConstants)
                    If InStr(c.Value, LeMot) Then
                         indx = indx + 1
                         c.Value = LeMot & "(" & indx & ")"
                    End If
               Next c
               Application.EnableEvents = True
          End If
          Set plage = Nothing
     End If
End If
End Sub

tu écrit le premier Dupont A1, il sera remplacé par Dupont(1), le suivant en D1 sera Dupont(2), le suivant en K1 sera Dupont(3)...
Si on ajoute en F1 il sera nommé Dupont(3) et celui qui était en K1 sera Dupont(4)...etc

26/12/2010, 09h19
abdel792

Merci Mercatog, ce code est beaucoup plus efficace !

J'ai juste fait une petite modif, pour que l'intervale de modification des valeurs soit de 15 jours à compter du jour courant et de l'heure courante.

J'ai modifier l'affectation de la valeur de Plage comme suit et ça fonctionne à merveille.

Encore merci à toi.

Code:

Set plage = Range(Cells(Target.Row, Target.Column), Cells(26, Target.Column + 15))

Amicalement.

Et pour encore formaliser

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Private Function MotSansSuff(Mot As String) As String
Dim f As Integer
 
f = InStr(Mot, "(")
f = IIf(f = 0, Len(Mot), f - 1)
MotSansSuff = Trim(Left(Mot, f))
End Function
 
Private Function KifKif(MotIni As String, Mot As String) As Boolean
 
KifKif = UCase(MotSansSuff(MotIni)) = UCase(Trim(Mot))
End Function
 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
Dim LeMot As String
Dim indx As Integer
 
If Target.Count = 1 Then
     If Target.Value <> "" Then
          LeMot = MotSansSuff(Target.Value)
          On Error GoTo ERREUR
          Application.EnableEvents = False
          For Each c In Range(Cells(Target.Row, 2), Cells(Target.Row, 255)).SpecialCells(xlCellTypeConstants)
               If KifKif(c.Value, LeMot) Then
                    indx = indx + 1
                    c.Value = LeMot & "(" & indx & ")"
               End If
          Next c
ERREUR:
          Application.EnableEvents = True
     End If
End If
End Sub

26/12/2010, 18h28
abdel792

Super Mercantog, tu es un maître !

Le problème est plus que résolu désormais grâce à ce super code.