Generer un code

[canard]

salut à tous et bon week-end,

je voulais savoir si il est possible de générer un code de la maniére suivante:

A1 = Drosera
B1 = Capensis alba
C1 = DCA01

En C1 c'est le code (celui-ci reprends la premiere lettre de chaque mot contenu dans les cellules A1 et B1 et y ajoute +1)

Est-ce possible ?

Si oui, peut on faire une gestion des doublons pour la valeur +1, c'est à dire que si le code DCA01 est deja présent dans la colonne C alors je passe a DCA02.

C'est peut etre beaucoup demandé, mais si c'est possible se serait super.

Merci d'avance et bonne soirée.
@+

 

[Hervé]

Bonsoir canard, le forum



En pièce jointe une tentative de réponse en VBA.

salut [file name=Classeur1_20051021234022.zip size=8020]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Classeur1_20051021234022.zip[/file]

Message édité par: Hervé, à: 21/10/2005 23:40

 

[myDearFriend!]

Bonsoir canard, Hervé,

Ci-dessous, une autre tentative :

Sub Traitement()
Dim Chaine As String, Num As String
Dim L As Long
      Application.ScreenUpdating = False
      With Sheets('Feuil1')
            For L = 1 To .Range('A65536').End(xlUp).Row
                  Chaine = PremLettre(.Cells(L, 1).Value) & PremLettre(.Cells(L, 2).Value)
                  Num = Format(WorksheetFunction.CountIf(.Columns(3), Chaine & '*') + 1, '00')
                  .Cells(L, 3) = Chaine & Num
            Next L
      End With
      Application.ScreenUpdating = True
End Sub

Function PremLettre(ByVal Exp As String) As String
Dim Mots As Variant
Dim C As Byte
      Mots = Split(WorksheetFunction.Proper(Exp))
      If UBound(Mots) >= 0 Then
            For C = 0 To UBound(Mots)
                  PremLettre = PremLettre & Left(Mots(C), 1)
            Next C
      End If
End Function

Cordialement,

 

[canard]

salut hervé,mydearfriend, le forum

super vos tentatives, merci.

vos deux code m'interresse beaucoup, mais celui de hervé me prend que la premiere lettre du premier mot mais par contre la valeur numérique ajoute +1 comme je voulais si le meme code existe deja.

et celui de mydearfriend me prends la premiere lettre de chaque comme je voulais, mais la valeur numérique ajoute +1 a tout les meme code,CAD si je code DRF01 existe deja alors tout les code DRF ajoute +1 donc je me retrouve avec plusieurs identique.

Moi je voulais aucun code identique comme dans le fichier de hervé.



J'ai essayé de croisé vos deux code mais je n'y suis pas arrivé.

Merci

Message édité par: canard, à: 22/10/2005 10:36

 

[canard]

ptit up

 

[soft]

Essaye ça :

Sub AjoutCode()
Dim strCode As String, I As Integer, L As Long, J As Long, N As Integer

L = 1
While Range('A' & L).Value <> ''
strCode = Left(Range('A' & L).Value, 1)
I = 1
Do While I > 0
I = InStr(I + 1, Range('A' & L).Value, ' ')
If I > 0 Then
strCode = strCode & Left(Mid(Range('A' & L).Value, I), 1)
End If
Loop
strCode = strCode & Left(Range('B' & L).Value, 1)
I = 1
Do While I > 0
I = InStr(I + 1, Range('B' & L).Value, ' ')
If I > 0 Then
strCode = strCode & Left(Mid(Range('B' & L).Value, I + 1), 1)
End If
Loop
J = 1
N = 0
While Range('C' & J).Value <> ''
x = Left(Range('C' & J).Value, Len(Range('C' & J).Value) - 2)
Y = strCode
If Left(Range('C' & J).Value, Len(Range('C' & J).Value) - 2) = strCode Then
If CInt(Right(Range('C' & J).Value, 2)) > N Then N = CInt(Right(Range('C' & J).Value, 2))
End If
J = J + 1
Wend

N = N + 1
If N < 10 Then
Range('C' & L).Value = strCode & '0' & N
Else
Range('C' & L).Value = strCode & N
End If
L = L + 1
Wend
End Sub

Message édité par: soft, à: 23/10/2005 10:30

 

[canard]

salut soft, le forum,

ton code ne fonctione pas bien, a chaque execution il me rajoute +1 a tout les code existant.

Merci quand meme.
@+

 

[soft]

Ajoute en 3e ligne (avant L=1)

Columns('C:C').ClearContents

 

[myDearFriend!]

Bonjour canard, Hervé, soft, le Forum.

Désolé canard mais, pour moi, le code que je t'ai donné fait ce que tu demandes (ou alors je n'ai rien compris)...
Ci-joint un exemple (que j'ai créé tout comme Hervé a du le faire... cela dit... trouves-tu logique que des fichiers exemples soit joints seulement aux réponses de ton fil et aucun avec la question ?)

Bon courage pour la suite et bonne fin de week-end.
Cordialement, [file name=PourCanard.zip size=8890]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/PourCanard.zip[/file]

 

[canard]

salut soft, le forum

la c'est mieu mais,
ce qui est bizarre dans ton code , c'est que par moment j'ai des espaces dans le code generer et d'autres fois non ???

Et il ne reconnais pas la case, car si un mot a une majuscule alors il genere un code different .

il faudrait que tout les codes soit en majuscule.

En tout cas merci de t'etre penché sur mon probléme.

@+

 

[canard]

salut mydearfriend, le forum,

desolé pour le fichier joint,

oui ton code marche mais deux fois de suite :

tu clik sur traitement => nikel
tu reclik sur traitement => tout les code générés prennent +1

merci quand meme, si tu as une idée du pourquoi ?

Merci
@+

 

[myDearFriend!]

Re canard,

oui, j'ai une idée du pourquoi canard : c'était tout simplement pas prévu !

Cela dit, compte tenu de ta remarque à soft plus haut (la même qu'ici) et de la solution qu'il t'a donné ensuite, j'aurais quand même cru qu'il te serait possible de trouver le rectificatif par toi même...

Alors tout comme pour soft, la remarque et la réponse sont les mêmes : rajouter une ligne qui effacera les éléments présents en colonne C avant nouveau traitement :

Sub Traitement()
Dim Chaine As String, Num As String
Dim L As Long
Application.ScreenUpdating = False
      With Sheets('Feuil1')
            .Columns(3).ClearContents
            For L = 1 To .Range('A65536').End(xlUp).Row
                  Chaine = PremLettre(.Cells(L, 1).Value) & PremLettre(.Cells(L, 2).Value)
                  Num = Format(WorksheetFunction.CountIf(.Columns(3), Chaine & '*') + 1, '00')
                  .Cells(L, 3) = Chaine & Num
            Next L
      End With
Application.ScreenUpdating = True
End Sub

La Function PremLettre() reste, quant à elle, inchangée.

Cordialement,

 

[canard]

salut à tous,

j'avais essayé mais pas reussi.

Je doit etre trop mauvais

Merci

 

[soft]

Salut Canard,
Je suis tout à fait de l'avis de myDearFriend!
On s'y met à 3 (merci aussi à Hervé) pour te faire ta macro et tu nous sort des nouvelles demandes en disant que ça marche pas ...

ça rajoute au code existant (on peut pas deviner que tu veux le faire plein de fois)
ou c'est pas en majuscules (tu nous l'as pas demandé)

Alors donnes-nous une demande complète ou un fichier joint.

Et cherches aussi s'il manque un petit truc.
On remplace pas la touche [F1]

 

[canard]

désolé de vous avoir importuné, comme je vois que je vous embéte avec mes demandes j'en reste la.

J'avais besoin de précisions pour améliorer ça (car j'ai encore un soucis), mais je vais allé chercher ailleurs.

Et faut pas croire que je ne cherche pas, j'en ai mal au crane.