[VBA] générer code unique incrémentiel sans passer par la feuille

Bonjour tout le monde,

Je dois générer des codes uniques pour une BDD. Les références seront ajoutées via USF. (2 premières lettres catégorie, puis tiret, puis nombre sur 3 caractères)

Il y a 4 catégories :

JEU : JE-000
AUDIO : AU-000
LIVRE : LI-000
VIDEO : VI-000

Comme vous pourrez le voir, j'arrive bien à récupérer le maximum pour chaque catégorie à l'aide d'une fonction matricielle (colonne K), mais j'aimerais me passer des données de la feuille et ne bosser qu'en VBA.

J'arrive à le faire en VBA avec le code suivant :

    nombre = Application.WorksheetFunction.CountIf(Feuil2.ListObjects("T_BDD").ListColumns("Code").DataBodyRange, Left(Me.ActiveControl.Caption, 2) & "*") + 1
    Txt_code = Left(Me.ActiveControl.Caption, 2) & "-" & Format(nombre, "000")

Le souci est que si on supprime une référence pour une raison ou une autre, il ne me proposera plus le maximum.

J'ai essayé de passer par evaluate, mais ça me met erreur 2015 à chaque fois, sans que je n'arrive à comprendre pourquoi :(

    tex = "JE-"
    Set plage = Feuil2.ListObjects("T_BDD").ListColumns("Code").DataBodyRange
    blabla = Evaluate("=MAX(IF(ISNUMBER(SUBSTITUTE(plage,tex,"""")*1),SUBSTITUTE(plage,tex,"""")*1,""""))")

J'imagine que je pourrais boucler sur toutes les valeurs de ma colonne code et récupérer les 3 derniers caractères, les transformer en nombre, garder le dernier (la base est toujours triée) et rajouter 1. Mais je me demandais s'il n'y avait pas un meilleur moyen.

Question subsidiaire :
Je n'arrive pas, via formule, en H5, à récupérer le nombre de documents prêtés depuis plus d'un mois. MOIS.DECALER n'aime vraiment pas être mis en matriciel.

Par avance merci pour votre précieuse aide !

Comme prévu, ça fonctionne comme cela :

Set plage = Feuil2.ListObjects("T_BDD").ListColumns("Code").DataBodyRange

            For Each cell In plage
                If cell Like Left(Me.ActiveControl.Caption, 2) & "*" Then compteur = Format(Val(Right(cell, 3)), "000")
            Next cell
                Txt_code = Left(Me.ActiveControl.Caption, 2) & "-" & Format(compteur + 1, "000")

Mais je ne sais pas pourquoi, je voudrais faire un peu différemment, plus 'élégamment'.

Bonjour JoyeuxNoel,

Pour la partie VBA je dirais, sans boucle :

Sub INCRE()
Dim L As Byte
With Worksheets("Données")
    .[K1:K4].ClearContents
    For L = 1 To 4
        .Cells(L, 11) = .Cells(L, 10) & Format(CLng(Application.Evaluate("=LARGE(IF(LEFT(T_BDD[Code],3)=""" & .Cells(L, 10) & """,VALUE(RIGHT(T_BDD[Code],3)),""""),1)")) + 1, "000")
    Next L
End With
End Sub

Pour la partie H5 je n'y suis pas arrivé avec la formule MOIS.DECALER non plus, donc je suis parti sur un worstcase en prenant 28j pour un mois :

=SOMME(SI(T_BDD[Sortie le]>0;SI(AUJOURDHUI()>T_BDD[Sortie le]+28;1;0))) 'En validation matricielle
=SOMMEPROD((T_BDD[Sortie le]<>"")*(AUJOURDHUI()>T_BDD[Sortie le]+28)) 'Sans validation matricielle

Cdlt,

Hello Ergotamine !

Merci beaucoup pour ce retour. J'ai pu tester et variabiliser tout ça, ça fonctionne nickel.

Je ne sais pas trop ce que j'ai foiré dans le evaluate. il doit manquer des guillemets quelque part au mieux, au pire c'est encore plus grave que ça. mais ça me dépasse.

Merci aussi pour la formule. J'avais fait un truc du genre, mais je ne trouvais pas ça satisfaisant. Je pensais arriver à trouver une autre façon de faire, mais ça coince toujours.

Bonjour,

Pour H5 : =NB.SI(T_BDD[Sortie le];"<="&MOIS.DECALER(AUJOURDHUI();-1)

si j'ai bien saisi.

@ bientôt

LouReeD

Bonjour,

Effectivement, dans l'absolu ça fonctionne aussi, merci.

J'avais une idée en tête sur ce que j'attendais, mais je crois que je ne m'en rappelle plus vraiment. Je suis tellement à fond dans ce fichier depuis 2 semaines que j'en perds un peu la boule :)

Bonsoir,

maintenant que je ne suis plus sur mon téléphone, voici ma petite contribution avec une fonction personnalisée :

@ bientôt

LouReeD

Bonjour à tous,

et pourquoi pas 4 variables dans 4 noms ?
A chaque utilisation tu ajoutes 1 et tu mets à jour ton nom pour avoir toujours le dernier utilisé.
eric

bonjour,

personnellement je passerai par une feuille de configuration!

Function AutoIncrement(Code As String)
Dim Sql As String, Cn As String, Rs As Object
Sql = "select * From  [Config$] where [Code]='" & Code & "';"
Cn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=YES;"""
Set Rs = CreateObject("ADODB.Recordset")
    Rs.Open Sql, Cn, 1, 3
If Rs.EOF Then
    Rs.addnew
    Rs("Code") = Code
    Rs("Value") = 0
End If
 Rs("Value") = Rs("Value") + 1
 Rs.Update
 AutoIncrement = Code & "-" & Format(Rs("Value"), "0000")
End Function
Sub test()
Debug.Print AutoIncrement("JE")
End Sub

Bonjour,

Merci pour vos retours.

J'ai également pour habitude d'écrire des données dans les feuilles pour stocker des choses. Ici, j'ai l'impression qu'il vaut mieux que je fasse le maximum en mémoire.

L'idée serait de faire un petit utilitaire sans prétention pour des MJC, ou de petites structures associatives qui sont amenées à prêter des documents et qui n'ont pas forcément les logiciels pour gérer ceci. Les ordinateurs utilisés ne seraient pas des bêtes de courses et j'avais dans l'idée qu'il était plus intéressant de ne pas trop écrire dans les feuilles.
Ça pourrait ressembler à quelque chose comme ceci :

Pour rendre le projet autonome, il y aurait une partie dans laquelle on pourrait paramétrer les caption des cases à cocher, voire en rajouter automatiquement. C'est notamment pour ceci que je préférais éviter de rentrer des choses en dur.

Fais-je fausse route selon vous ?

Re,

avoir une feuille de paramètrage, ce n'est plus en dur.

Au lieu de case à cocher tu pourrais prévoir une liste déroulante ou une listbox.
Celle-ci serait alimentée par la 1ère colonne du tableau de paramètre, la 2nde étant le dernier n° utilisé.
Un simple ajout de ligne au tableau t'étend le nombre de variables sans besoin de toucher le code.

Et une simple lecture de cellule contre une matricielle, tu ne seras pas perdant.
eric

Re,

Merci pour ton retour.

J'imagine que tu as raison. Autant je ne suis pas fan de la liste déroulante pour ça, autant la listbox pourrait convenir.

Pour qui est du besoin de retoucher le code, un module de classe aurait permis de ne rien avoir à toucher, mais :

- je n'en suis pas encore là

- la listbox permet effectivement de gérer ceci de façon encore plus triviale.

non, non. n'insiste pas, je ne t'aiderai pas sur les modules de classes

eriiic a écrit :

non, non. n'insiste pas, je ne t'aiderai pas sur les modules de classes

Bon, OK, tant pis, je vais essayer tout seul :)

Mais de ce que j'ai déjà vu, je crois que pour quelque chose de "simple" comme ça, ça va le faire.

Bonjour à tous,

Pour éviter d'avoir les données en dur dans le code, il faudrait les avoir dans une petite liste (tableau structuré à 1 colonne) sur une feuille (cachée éventuellement).

Et, à moins de prévoir la multisélection, ce dont je doute, une combobox serait très bien j'ai l'impression.

Quant au module de classe, il ne me parait pas nécessaire dans ce cas, il faudrait plutôt alimenter cette combobox/listbox (ou création dynamique de checkbox) à l'initialisation de l'userform à partir d'une fonction/procédure publique d'un module standard. Par exemple :

'module UF
private sub userform_initialize()
with me
    .combobox1.list = GetList(range("MaListe")) 'MaListe contient les produits
end with
end sub

'Module normal
function GetList(Source as range)
GetList = application.transpose(Source.value)
end function

PS : Il manque un "c" à Accueil .

Bon, j'imagine que ça passe comme ça aussi ^^

"PS : Il manque un "c" à Accueil"

Bien vu ! Ça m'apprendra à vouloir faire un multipages bidon et pas fonctionnel pour faire le malin juste avant de poster ^^

edit : Pour ce qui est des combobox, je ne suis vraiment pas fan s'il n'y a pas une tripotée de choix différents. On ne les voit pas tous, il faut un clic supplémentaire pour afficher tout ça, puis éventuellement scroller pour avoir tous les choix (pas possible dans USF en plus ...)