implementer un code alphanumérique

Version imprimable

Bonjour a tous !

J'ai un bout de code, que voici :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 Dim code As String code = Sheets("PROGRAMME").Range("D14").Text Dim l As Integer Dim myRange As Range Dim num As Long Dim dl1 As Long ' dernière ligne dl1 = Sheets("ORIGINALE").Range("K65536").End(xlUp).Row Set myRange = Sheets("ORIGINALE").Range("K" & dl1) num = Application.WorksheetFunction.Max(myRange) + 1 Sheets("ORIGINALE").Unprotect Password:="popol" Sheets("ORIGINALE").Select l = Sheets("ORIGINALE").Range("K65000").End(xlUp).Row + 1 With Sheets("ORIGINALE") .Range("K" & l) = code & num End With Sheets("ORIGINALE").Protect Password:="popol" Sheets("PROGRAMME").Activate
qui devrait me servir a implémenter un code alphanumérique d'une ligne a l'autre (cellule K17 = ZZ1, cellule K18 = ZZ2, etc), mais malheureusement ce code ne marche pas dans mon projet...mais il fonctionne dans un nouveau projet vide !

Je vous demande donc si le fait que j'ai ceci pour implémenter mes lignes :
Code:

1 2 Dim Ligne As Long Ligne = Sheets("ORIGINALE").Range("A" & Rows.Count).End(xlUp).Row + 1
pourrais entrer en conflit avec l'autre bout de code??? sinon ou est le problème???

Merci de le tester chez vous et de m'aider avec ceci.

PS: je l'ai déjà dit mais je le réitère: je suis plutôt novice en vba !! :oops:

03/03/2012, 19h41
gFZT82

Bonjour,

En toute rigueur, tu dois écrire

Code:

Ligne = Sheets("ORIGINALE").Range("A" & Sheets("ORIGINALE").Rows.Count).End(xlUp).Row + 1

Cordialement.

Bonjour,

Il y a plusieurs lignes dont je n'ai pas bien compris l'intérêt :
Code:

1 2 3 4 5 6 Dim myRange As Range Dim num As Long Dim dl1 As Long ' dernière ligne dl1 = Sheets("ORIGINALE").Range("K65536").End(xlUp).Row Set myRange = Sheets("ORIGINALE").Range("K" & dl1) num = Application.WorksheetFunction.Max(myRange) + 1
La valeur maximum d'une cellule, c'est la valeur de la cellule. Pourquoi chercher un maximum sur une cellule avec WorksheetFunction.Max?

La sélection d'une feuille n'est pas nécessaire pour exécuter un code qui modifie le classeur. Donc Sheets("ORIGINALE").Select doit être inutile.

Sinon pour ce qui est de faire une concaténation d'une cellule se trouvant en
Feuille PROGRAMME, cellule D14, en incrémentant l'indice de la dernière concaténation qui se trouve en feuille "Originale", fin de la colonne K.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 With Worksheets("ORIGINALE") .Unprotect Password:="popol" Dim code As String code = Worksheets("PROGRAMME").[D14].Value Dim dl1 As Long ' dernière ligne dl1 = .Range("K" & Rows.Count).End(xlUp).Row Dim num As Long If Len(.Range("K" & (dl1)).Value) > Len(code) Then num = Mid(.Range("K" & (dl1)).Value, Len(code) + 1) + 1 Else num = 1 End If .Range("K" & (dl1 + 1)).Value = code & num .Protect Password:="popol" End With
Edit : Autre solution si le code ne change pas, on peut utiliser l'autofill :
Code:

1 2 3 4 5 If Len(.Range("K" & (dl1)).Value) > Len(code) Then .Range("K" & (dl1)).AutoFill Destination:=.Range("K" & dl1 & ":K" & (dl1 + 1)), Type:=xlFillDefault Else .Range("K" & (dl1 + 1)).Value = code & 1 End If

03/03/2012, 21h30
Biggy30

Salut Blue Monkey et merci pour ton code
mais j'ai une erreur "Incompatibilité de type" sur cette ligne:

Code:

num = Mid(.Range("K" & (dl1)).Value, Len(code) + 1) + 1

J'imagine que comme mes données sont entrées a partir de la ligne 17 et non de la ligne 1 c'est pour ca que ca ne fonctionne pas ?!?!?

C'est malheureux car mon code "fonctionnait" jusqu'a un certain point...il ajoutais la lettre (code) inscris dans la cellule D14 de la feuille PROGRAMME ,le seul hic c'est qu'il écrivais toujours un 1 apres le code je voudrais simplement une légère modification de mon code qui fasse en sorte que le chiffre apres le code se concatène...(comme vous dites)8O

et au passage, désolé du manque d'éducation mais c'est quoi Len
ex:

Code:

Len(.Range("K" & (dl1)).Value) > Len(code) Then

que vaut, ou représente Len ??

Merci d'avance

Re.

Citation:

je voudrais simplement une légère modification de mon code qui fasse en sorte que le chiffre apres le code se concatène

Le soucis est que le code donné est premier post contient plusieurs partie dont je ne comprends pas l'utilité (voir questions précédentes).
Et pour maintenir il est toujours préférable de partir de quelque chose d'aussi simple que possible. C'est pourquoi j'ai simplifié, tout faisant la même fonction.

Citation:

j'ai une erreur "Incompatibilité de type"

Le message d'erreur provient probablement qu'en [K17] on a des caractères qui ne correspondent pas au format <code>+<incrément numérique>.
Est ce qu'il est possible de vérifier le contenu de [K17]?

Si dans la partie numérique, on a des lettres au lieu de ce qui a été présenté, il y aura une incompatibilité de type.

Citation:

J'imagine que comme mes données sont entrées a partir de la ligne 17 et non de la ligne 1 c'est pour ca que ca ne fonctionne pas

dl1 = .Range("K" & Rows.Count).End(xlUp).Rows'occupe de retrouver le numéro de la dernière ligne non vide de la colonne K.
Ca devrait commencer en ligne K17 si cette cellule n'est pas vide.

Autre solution de code si le numéro de l'incrément commence toujours en ligne 17 :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 With Worksheets("ORIGINALE") .Unprotect Password:="popol" Dim code As String code = Worksheets("PROGRAMME").[D14].Value Dim dl1 As Long ' dernière ligne dl1 = .Range("K" & Rows.Count).End(xlUp).Row If dl1 <= 16 Then dl1 = 16 .Range("K" & (dl1 + 1)).Value = code & (dl1 - 15) .Protect Password:="popol" End With
Len(<chaîne de caractère>) retourne le nombre de caractère d'une chaîne.

03/03/2012, 22h32
Biggy30

Tout d'abord merci de ton aide et de ta patiente !

Premierement, a la base, toute les cellules sont vides sur cette feuille donc K17 est vide, je ne sais pas si ca peut causer l'erreur Incompatibilité

Et secondo, oui, mes lignes se remplissent toujours depuis la ligne 17 donc j'essaie ton autre code et je te reviens la dessus

Merci infiniement !:)
03/03/2012, 22h41
Biggy30

IMPEC MONSIEÛX !!!!

C'est toi le roi du labo !!!
C'est exactement ce que je cherchais!!

Merci mille fois Blue Monkey
Cordialement:ccool::ccool::ccool::ccool:
03/03/2012, 22h44
BlueMonkey

Content que le code fonctionne comme tu le souhaites. :ccool:
Je suis sur que lorsque tu reviendras sur ce code, ça sera plus simple à comprendre que le code d'origine. :D
Bonne après-midi.

P.S. Je ne m'explique pas le plantage de la première version du code. (même avec toutes les cellules vides ça fonctionnait.
Mais bon maintenant qu'il y a une solution qui marche, on va pas de faire des noeuds dans la tête. :D
10/03/2012, 05h02
Biggy30

2 pièce(s) jointe(s)

Salut BlueMonkey...

comme je te disais dans le message privé que je t'ai envoyé,
j'ai 2 capture d'écran pour te montrer les 2 pépins que je dois
contourner

Bonsoir,

D'après les captures d'écrans tu souhaites ajouter une valeur, une ligne sur 2, en partant de la ligne 17 et dans la colonne "K".
Si c'est bien le cas, essaye ceci. Sinon il faudra expliquer les règles qui définissent la ligne d'insertion du résultat alphanumérique.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
 
    With Worksheets("ORIGINALE")
            .Unprotect Password:="popol"
 
            Dim code As String
            code = Worksheets("PROGRAMME").[D14].Value
            Dim dl1 As Long
            dl1 = GetLastLine()
            .Range("K" & (17 + (dl1 - 1) * 2)).Value = code & dl1
 
            .Protect Password:="popol"
    End With

Et en ajoutant cette fonction dans la même feuille ou module

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Function GetLastLine() As Long
    Dim dl1 As Long ' dernière ligne
    dl1 = 1
 
    With Worksheets("ORIGINALE")
        Dim r As Range
        For Each r In .Range("K17:K" & .Range("K" & Rows.Count).End(xlUp).Row)
            If (r.Value <> "") Then
                dl1 = dl1 + 1
            End If
        Next r
    End With
 
    GetLastLine = dl1
End Function

10/03/2012, 14h57
Biggy30

Salut BlueMonkey

tout d'abord merci bcp pour toute l'aide que tu m'as apporter jusqu'a maintenant...

Bon en fait c'est très aléatoire mon truc....je ne veux pas un code une ligne sur deux....mais un code sur la meme ligne ou figure les quantités disons....car quelques fois les données d'une porte d'armoire se retrouve sur 2 lignes selon les options que je choisis, quelques fois juste sur une ligne et d'autres fois les données peuvent s'étaler sur 4 lignes pour le même item, dans ce dernier cas comme pour les autres je désirerais avoir le code sur la première ligne de l'item

je sais c'est complexe !!! si cela n'est pas fesable...j'entrerai les codes manuellement..tant pis !!8O

Merci

Bonjour,

Citation:

je ne veux pas un code une ligne sur deux....mais un code sur la meme ligne ou figure les quantités

Si les quantités figurent dans la colonne C et les codes à ajouter dans la colonne K, ceci devrait fonctionner.

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
With Worksheets("ORIGINALE")
            .Unprotect Password:="popol"
 
            Dim code As String
            code = Worksheets("PROGRAMME").[D14].Value
 
            Dim dl1 As Long
            dl1 = 0
            With Worksheets("ORIGINALE")
                Dim r As Range
                For Each r In .Range("C17:C" & .Range("C" & Rows.Count).End(xlUp).Row)
                    If (r.Value <> "") Then 'Quantité non vide
                        dl1 = dl1 + 1
                        If (r.Offset(0, 8).Value = "") Then ' code alphanumérique vide
                            r.Offset(0, 8).Value = code & dl1
                            Exit For
                        End If
                    End If
                Next r
            End With
 
            .Protect Password:="popol"
    End With
End Sub

10/03/2012, 15h48
Biggy30

la case K est vide...rien ne s'y écrit :koi:
10/03/2012, 15h50
BlueMonkey

Les quantités sont bien en colonne C, et les cellules en colonne K sont bien vide (sans formule) ?
10/03/2012, 15h55
Biggy30

non en fait les quantités sont en A donc j'ai changé C pour A mais le code de l'item ne s'écris plus...la cellule K reste vide

Si la quantité se trouve en A, il faut ajuster les offsets entre A et K

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
With Worksheets("ORIGINALE")
            .Unprotect Password:="popol"
 
            Dim code As String
            code = Worksheets("PROGRAMME").[D14].Value
 
            Dim dl1 As Long
            dl1 = 0
            With Worksheets("ORIGINALE")
                Dim r As Range
                For Each r In .Range("A17:A" & .Range("A" & Rows.Count).End(xlUp).Row)
                    If (r.Value <> "") Then 'Quantité non vide
                        dl1 = dl1 + 1
                        If (r.Offset(0, 10).Value = "") Then ' code alphanumérique vide
                            r.Offset(0, 10).Value = code & dl1
                            Exit For
                        End If
                    End If
                Next r
            End With
 
            .Protect Password:="popol"
    End With
End Sub

oui t'inquiète je les ai changé aussi...mais ca ne fonctionne pas

Petite question pertinente :

avec ce code que tu m'avais refilé :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
Sub codage()
 
With Worksheets("ORIGINALE")
        .Unprotect Password:="popol"
 
        Dim code As String
        code = Worksheets("PROGRAMME").[D14].Value
        Dim dl1 As Long ' dernière ligne
        dl1 = .Range("K" & Rows.Count).End(xlUp).Row
        If dl1 <= 16 Then dl1 = 16
        .Range("K" & (dl1 + 1)).Value = code & (dl1 - 15)
 
        .Protect Password:="popol"
End With
End Sub

pourrais-je appeler la procédure directement dans l'ajout d'un range sur une autre procédure ?? exemple: (j'ai tronqué le code regarde sur le range k)

Code:

1
2
3
4
5
6
7
8
 
Sheets("ORIGINALE").Range("I" & Ligne + 1) = "M2: " & Sheets("PROGRAMME").Range("E27") & """"
Sheets("ORIGINALE").Range("J" & Ligne + 1) = " "
Sheets("ORIGINALE").Range("K" & Ligne + 1) = codage 'ici
Sheets("ORIGINALE").Range("L" & Ligne + 1) = " "
Sheets("ORIGINALE").Range("M" & Ligne + 1) = "TR1: " & Sheets("PROGRAMME").Range("E28") & """"
Sheets("ORIGINALE").Range("N" & Ligne + 1) = "TR2: " & Sheets("PROGRAMME").Range("E29") & """"
Sheets("ORIGINALE").Range("O" & Ligne + 1) = " "

cela fonctionnerait-il ??

10/03/2012, 16h27
BlueMonkey

Les quantités commencent bien après la ligne 17 ?
Le code alpha à ajouter se trouve bien dans la feuille "PROGRAMME" cellule D14 ?

[Edit]

Citation:

pourrais-je appeler la procédure directement dans l'ajout d'un range sur une autre procédure

Je ne vois pas ce que c'est que "l'ajout d'un range sur une autre procédure".
Mais dans le principe on peut appeler une routine SUB ... End Sub depuis n'importe quelle autre routine.
(à condition de respecter les limitations de portée Private, Public ... pour des routines déclarées dans d'autres modules)

Mais pour affecter le résultat d'un appel de routine, il faut que ce soit une fonction (qui retourne une valeur).

Ce qui suit ne fonctionnera pas car codage ne retourne pas de valeur.

Code:

Sheets("ORIGINALE").Range("K" & Ligne + 1) = codage
10/03/2012, 16h41
Biggy30

ok donc si ma procédure s'appelle codage...
puis-je faire ceci :

Code:

Sheets("ORIGINALE").Range("K" & Ligne + 1) = codage

ou il faut absolument mettre l'argument Call ??
et oui ca commence bien en ligne 17
et le code alpha est bien sur la feuille PROGRAMME D14
10/03/2012, 16h50
BlueMonkey

Citation:

ou il faut absolument mettre l'argument Call ??
et oui ca commence bien en ligne 17
et le code alpha est bien sur la feuille PROGRAMME D14

Je ne vois pas d'explication au problème.
Est-ce que tu peux poster un fichier pour trouver d'où vient le problème.

Citation:

puis-je faire ceci :
Sheets("ORIGINALE").Range("K" & Ligne + 1) = codage

Ca n'est pas possible parce que codage ne retourne pas de valeur.
Il faudrait que ce soit une fonction qui retourne une valeur.

Re.

Le code de la fonction codage() utilisé dans le fichier, n'est pas celui posté en post #16

Ci-dessous les modifications que tu as effectué, et qui entraîne des problèmes.

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
Sub codage()

With Worksheets("ORIGINALE")
           ' .Unprotect Password:="popol"
 
            Dim code As String
            code = Worksheets("PROGRAMME").[D14].Value
 
            Dim dl1 As Long
            dl1 = 0
            With Worksheets("ORIGINALE")
                Dim r As Range
                '16 correspond à la ligne de titre, pas la première ligne de valeur 
                For Each r In .Range("A16:A" & .Range("A" & Rows.Count).End(xlUp).Row)
                    If (r.Value <> " ") Then ' " " est un caractère espace, pas une chaîne vide
                        dl1 = dl1 + 1
                        If (r.Offset(0, 10).Value = " ") Then ' " " est un caractère espace, pas une chaîne vide
                            r.Offset(0, 10).Value = code & dl1
                            Exit For
                        End If
                    End If
                Next r
            End With
 
            '.Protect Password:="popol"
    End With
    Sheets("PROGRAMME").Activate
End Sub

Utilise exactement (copier / coller) le code posté en post #16, et si la colonne quantité contient une valeur, codage fonctionnera.

10/03/2012, 22h41
Biggy30

je suis désolé j'ai comis une faute :aie:
le code en post 16 fonctionne effectivement sauf si j'insère une ligne vide
le code passe de disons...A4 a A6, A5 étant la ligne vide (il n'apparait pas bien sur)

ce que je voudrais c'est que si j'insere une ligne vide, l'alpha ne s'implémente pas pour cette ligne mais pour la suivante...

exemple: si en ligne 19 j'ai un item avec le code A3
puis la ligne 20 est vide
puis en ligne 21 j'ai un item avec le code A4 et non A5

je sais pas si je suis assez clair :calim2:

merci bcp :D
10/03/2012, 22h53
BlueMonkey

Re.

Pas de problème. On fait tous des erreurs. :D

Mais je ne comprends pas cette partie :

Citation:

si en ligne 19 j'ai un item avec le code A3, puis la ligne 20 est vide
puis en ligne 21 j'ai un item avec le code A4 et non A5

C'est pas tout le contraire de ce qui était demandé ici ?
http://www.developpez.net/forums/att.../capture1.png/
10/03/2012, 23h05
Biggy30

non c'est exactement ca en fait...sur cette image, j'ai encerclé le deuxième item par contre il est numéroté comme étant le troisième (S3) et devrait plutot se nommer S2 même si je passe une ligne vide

autrement dit je voudrais empêcher la concaténation si il y a des lignes vides
10/03/2012, 23h25
BlueMonkey

Dans ce cas si les lignes sont vides (y compris la colonne quantité) ça devrait fonctionner.
En tous les cas lors de mes tests avec le code du post #16 ça fonctionne.
11/03/2012, 00h42
Biggy30

Bon tant pis...ou alors je me suis mal exprimé ou alors c'est bizarre car chez moi ca ne fonctionne pas 8O8O

merci a toi énormement pour toute l'aide apporté jusqu'a présent

Cordialement

:ccool:

Re.

Je pense avoir reproduit le problème.
Lorsque des lignes "vides" sont insérées via le formulaire, ce sont des caractères " " qui sont ajoutés.

Avec le code ci-dessous, le problème semble corrigé.

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
Sub codage()
 
    With Worksheets("ORIGINALE")
            .Unprotect Password:="popol"
 
            Dim code As String
            code = Worksheets("PROGRAMME").[D14].Value
 
            Dim dl1 As Long
            dl1 = 0
            With Worksheets("ORIGINALE")
                Dim r As Range
                For Each r In .Range("A17:A" & .Range("A" & Rows.Count).End(xlUp).Row)
                    If Trim(r.Value) <> "" Then 'Quantité non vide
                        dl1 = dl1 + 1
                        If (r.Offset(0, 10).Value) = "" Then ' code alphanumérique vide
                            r.Offset(0, 10).Value = code & dl1
                            Exit For
                        End If
                    End If
                Next r
            End With
 
            .Protect Password:="popol"
    End With
 
    Sheets("PROGRAMME").Activate
End Sub

11/03/2012, 13h15
Biggy30

Haaaaaa !

Voilou voilà !! Là c'est vraiment au poil !
Merci infiniement Blue Monkey pour toute ton aide je t'en suis
extremement reconaissant, grace a toi mon programme est nickel
comme je le voulais...

Cordialement
Éric

:ccool::merci::merci::chin:
11/03/2012, 13h28
BlueMonkey

Re.

Content pour toi que tu aies finalement une solution qui convienne. :ccool:
Bonne journée.

Fuseau horaire GMT +2. Il est actuellement 19h10.