incrémenter en fonction du nombre d'occurences

[daniel]

Bonjour le Forum !

Voici mon nouveau problème… que j'essaie en vain de résoudre avec l'évènment Wroksheet_Change

Dans une colone, j'ai un grand nombre de codes uniques. Lors de la saisie de nouveaux codes, je voudrais qu'il ne puisse pas y avoir de doublons : jusqu là pas de problème (vous m'avez déjà fourni la solution !).

Mais là où ça se corse, c'est que je voudrais incrémenter le code que je saisis, si celui-ci existe déjà !

Exemple : j'ai dans ma colone le code :TOTO. Si je saisis de nouveau TOTO, je voudrais que celui-ci devienne automatiquement TOTO-2. Jusqu'à ce niveau, j'ai réussi… avec le code suivant :

If Application.WorksheetFunction.CountIf(Range('A:A'), Target.Value) > 1 Then
Target.Value = Target & '-' & Application.WorksheetFunction.CountIf(Range('A:A'), Target.Value)  
End If

Mais si je rentre de nouveau TOTO, j'aimerais qu'il devienne TOTO-3 et ainsi de suite… Et là, pas moyen…

Merci pour vos suggestions…

Daniel

 

[Hervé]

Bonjour daniel

j'ai pas bien compris, si tu n'a pas de doublons (j'ai un grand nombre de codes uniques) tu ne peux pas incrémenter le nouveau code ( le code que je saisis, si celui-ci existe déjà !).

Y'a une contradiction dans ton enoncé.

en tout cas voici un code qui incrémente les codes doublons en leur ajoutant +1 à chaque fois.

j'ai un peu fait dans l'artillerie lourde, mais je sais pas faire autrement.

Il doit y avoir plus simple, attendons les copains.

Dim pasbon As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
Dim j As Integer
Dim tablo As Variant
Dim tiret As Byte
Dim present As Boolean

If Target.Count > 1 Then Exit Sub
If Target.Row = 1 Then Exit Sub

If pasbon = True Then
        pasbon = False
        Exit Sub
End If

For j = Target.Row - 1 To 1 Step -1
        tablo = Split(Cells(j, 1), ' - ')
        If tablo(0) = Target Then
                present = True
                tiret = InStr(1, Cells(j, 1), ' - ')
                Exit For
        End If
Next j

If present = True Then
&nbsp; &nbsp; &nbsp; &nbsp; If tiret <> 0 Then
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; pasbon = True
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Target = Target & ' - ' & tablo(1) + 1
&nbsp; &nbsp; &nbsp; &nbsp; Else
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; pasbon = True
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Target = Target & ' - 1'
&nbsp; &nbsp; &nbsp; &nbsp; End If
End If
End Sub

salut

 

[daniel]

Hello Hervé, le forum

Super hervé, c'est exactement ce que je voulais ! Désolé de ne pas avoir été clair. enf ait, je voulais que le doublon éventuel se 'dédoublonneé' en étant incrémenté d'une unité à chaque fois. Ce que ton code fait à merveille !

Un grand merci

Daniel

 

[Hervé]

re

Ah ben si ce code te convient, on va le blinder un peu plus.

le meme mais ne travaille que sur la colonne A, et autorise des lignes vides entre les codes.

Dim pasbon As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
Dim j As Integer
Dim tablo As Variant
Dim tiret As Byte
Dim present As Boolean
If Target.Column <> 1 Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Target.Row = 1 Then Exit Sub
If pasbon = True Then
&nbsp; &nbsp; &nbsp; &nbsp; pasbon = False
&nbsp; &nbsp; &nbsp; &nbsp; Exit Sub
End If
For j = Target.Row - 1 To 1 Step -1
&nbsp; &nbsp; &nbsp; &nbsp; If Cells(j, 1) <> '' Then
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; tablo = Split(Cells(j, 1), ' - ')
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; If tablo(0) = Target Then
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; present = True
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; tiret = InStr(1, Cells(j, 1), ' - ')
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Exit For
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; End If
&nbsp; &nbsp; &nbsp; &nbsp; End If
Next j
If present = True Then
&nbsp; &nbsp; &nbsp; &nbsp; If tiret <> 0 Then
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; pasbon = True
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Target = Target & ' - ' & tablo(1) + 1
&nbsp; &nbsp; &nbsp; &nbsp; Else
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; pasbon = True
&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; Target = Target & ' - 1'
&nbsp; &nbsp; &nbsp; &nbsp; End If
End If
End Sub

salut

 

[Charly2]

Bonsoir Daniel et Hervé,

Autre solution en reprenant tout simplement le code de Daniel :

Dim NbTOTO As Integer
'
NbTOTO = WorksheetFunction.CountIf(Range('A:A'), Target.Value)
'
  Select Case NbTOTO
    Case 2 To 9
      Target = Right(Target.Value, 1, Len(Target.Value) - 2) & '-' & NbTOTO
    Case 10 To 99
      Target = Right(Target.Value, 1, Len(Target.Value) - 3) & '-' & NbTOTO
    Case 100 To 999
      Target = Right(Target.Value, 1, Len(Target.Value) - 4) & '-' & NbTOTO
    Case Else
      MsgBox 'Ras le bol des TOTOs !!!'
    End Select

A+
Charly

 

[daniel]

Bonjour Hervé, Charly, le forum !

Merci Hervé, pour ton code amélioré. J'avais remarqué que le précédent ne gérait pas les lignes vides, mais ce n'était pas gênant.
Charly, j'ai essayé ton code, mais Excel m'indique que le nombre d'arguments de la procédure est incorrect ?!

En tout cas, merci pour votre

Excellente journée

Daniel

 

[Charly2]

Bonjour Daniel et Hervé, bonjour tout le monde

Je ne saisis pas bien le message d'erreur (?), mais heureusement qu'il te l'a délivré car je m'aperçois qua j'ai oublié un tas de cas !!!

Comme je le disais dans un autre post, les codes les plus courts ne sont pas forcément les plus efficaces ni les plus rapides ! Je devrais me le répéter plus souvent

Amitiés
Charly