Générer référence unique par ligne à partir données sur même ligne BDD

Fermé
JeanDeLaTerre Messages postés 1 Date d'inscription jeudi 5 novembre 2020 Statut Membre Dernière intervention 5 novembre 2020 - 5 nov. 2020 à 17:52
yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 - 5 nov. 2020 à 18:46
Bonjour,

Je viens demander de l'aide pour fiabiliser une macro qui a été faite par quelqu'un d'autre et qui ne me satisfait pas. Cependant, mes connaissances VBA sont très minces ! Je trouve dommage de tout supprimer et faire avec des formules, car j'ai peur au temps de traitement quand la feuille sera bien remplie !

Le contexte : générer une référence unique (qui correspond en réalité à un document word ou xls ou autocad...) prenant en compte les éléments de la ligne de la base de données.

Exemple : la référence PRO_2020_004_SYN_CR_003_01 correspond à un document du domaine PROjet _ de l'année 2020 _ dont le code projet est 004 _ de la phase SYN _ de type CR _ étant le 003ème CR de ce PROjet dans cette phase SYN_ en version 01 de ce CR.

Vous suivez ?!

Autre exemple : la référence QUA_OR_001_00 correspond à un document du domaine QUAlité _ de type OR _ c'est le 001ème document de ce type dans ce domaine _ en version 00.

Le problème :
1 - Le code ne prends pas en compte la spécification du domaine. Si c'est un PROjet, la référence reprend l'année, le numéro du projet et la phase projet. Ce qui n'est pas le cas pour une référence d'un autre domaine.
2 - Le code ne prends pas en compte l'intitulé du document, utile pour incrémenter le dernier chiffre de la référence, qui correspond à la version du document.
3 - ça ne s'incrémente plus !

Merci à tous ceux qui auront pris le temps de me lire. J'ai les yeux qui pleure à force de lire le code sans comprendre ce que je dois modifier !

Une capture du tableau est faite pour connaître la référence des colonnes et le code est ci-dessous.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Ligne As Variant, Res As Variant, C As Range, Proj As String
  Dim CodeDoc As Long
  If Target.Count > 1 Then Exit Sub
  
  'Désactivation des macros sur les évènements
  Application.EnableEvents = False
   
  'Modification colonne J
  If Target.Column = 10 Then
    'Recherche de la première ligne ayant le même intitulé de projet
    Ligne = Application.Match(Cells(Target.Row, 6), [F:F], 0)
    '"Proj" = l'intitulé de projet
    Proj = Cells(Ligne, 6)
    'Boucle sur chaque cellule de la colonne K
    CodeDoc = 0 'permet de commencer à 001'
    For Each C In Range("K5", Cells(Target.Row - 1, 11))
'      If C.Offset(, -5) = Proj Then Stop
      Debug.Print C.Offset(, -1)
      If C.Offset(, -5) = Proj And C.Offset(, -1) <> Target Then
        CodeDoc = Application.Max(C, CodeDoc)
      ElseIf C.Offset(, -5) = Proj And C.Offset(, -1) = Target Then
        CodeDoc = C - 1
    Exit For
  End If
    Next C
    Cells(Target.Row, 11) = CodeDoc + 1
    Res = -1
    For Each C In Range("F5", Cells(Target.Row - 1, 6))
'      If C = Proj Then Stop
      If C = Proj And C.Offset(, 4) = Target Then
        Res = C.Offset(, 6)
      End If
    Next C
    Cells(Target.Row, 12) = Res + 1
  End If
  'Activation des macros sur les évènements
  Application.EnableEvents = True
End Sub




Configuration: Windows / Firefox 82.0
A voir également:

1 réponse

yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476
5 nov. 2020 à 18:30
bonjour,
peux-tu préciser le résultat obtenu quand le code tourne? et le résultat attendu? sois précis: quelle valeur, quelle cellule.
explique également ce qui a changé, pourquoi la macro ne convient plus. elle a arrêté de bien fonctionner, ou bien souhaites-tu qu'elle se comporte autrement?
il me semble utile que tu partages ton fichier.
tu n'as probablement pas spécifier "basic" quand tu as utilisé les balises de code.
0
yg_be Messages postés 22720 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 23 avril 2024 1 476
5 nov. 2020 à 18:46
pourquoi penses-tu que des formules seraient plus lentes?
n'est-ce pas appréciable d'utiliser une technique que tu comprends?
0