création d'une clé unique via userform

Vilain

XLDnaute Accro
Bonsoir à tous,

Je reviens vers vous avec un petit problème vba insoluble pour moi.
J'ai dans ma ligne 1 des titres de la colonne A à la colonne M.
J'ai ensuite des données sur un nombre de lignes variables (mais toutes les cellules sont remplies).
Je souhaiterai afficher un userform me permettant de créer une clé unique via les données présentes dans les colonnes.
Je m'explique : il faudrait un userform avec des cases à cocher avec les titres des colonnes. Dans mon exemple, si on coche a,b,c par exemple, la clé unique de N2 devra alors etre une concaténation des données de A2, B2, C2, soit "A1A2A3".
Est-ce clair pour vous ?
Merci par avance pour votre aide
 

Pièces jointes

  • Classeur1.xls
    61 KB · Affichages: 49
  • Classeur1.xls
    61 KB · Affichages: 50

Vilain

XLDnaute Accro
Re : création d'une clé unique via userform

Bonsoir et merci pour cette solution.
On est sur la bonne voie.
Pour être exact, je souhaiterai que ce soit quand on lance la macro que l'userform se lance. Je souhaite ensuite qu'on sélectionne dans l'userform et que le choix sélectionné s'applique pour toute la colonne (voir fichier joint).
Encore merci pour l'aide apportée
 

Pièces jointes

  • Classeur1.xls
    57 KB · Affichages: 42
  • Classeur1.xls
    57 KB · Affichages: 49

job75

XLDnaute Barbatruc
Re : création d'une clé unique via userform

Bonjour Gilles, Chris401,

S'il y a beaucoup de lignes ce code est bien plus rapide :

Code:
Dim P As Range 'mémorise la variable

Private Sub UserForm_Initialize()
Set P = [A1].CurrentRegion.Offset(1).Resize(, 13)
ListBox1.List = Application.Transpose(P.Rows(0))
End Sub

Private Sub CommandButton1_Click()
Dim cle$, col%
cle = """"""
For col = 1 To P.Columns.Count
  If ListBox1.Selected(col - 1) Then cle = cle & "&" & P.Columns(col).Address
Next
P.Columns(14) = Evaluate(cle)
End Sub

Private Sub CommandButton2_Click()
P.Columns(14).ClearContents
UserForm_Initialize
End Sub
Fichier joint.

A+
 

Pièces jointes

  • Clé unique(1).xls
    45.5 KB · Affichages: 58

job75

XLDnaute Barbatruc
Re : création d'une clé unique via userform

Bonjour Gilles, le forum,

S'il n'y a que cette affaire de clé unique pas besoin d'UserForm :

Code:
Private Sub CommandButton1_Click()
Dim P As Range, h&, Q As Range, cle$, c As Range
Set P = [A1].CurrentRegion.Offset(1).Resize(, 13)
h = P.Rows.Count
P.Columns(14).ClearContents 'RAZ
P.Interior.ColorIndex = xlNone 'RAZ
Set Q = Intersect(P.Rows(0), Selection)
If h = 1 Or Q Is Nothing Then Exit Sub
cle = """"""
For Each c In Q
  cle = cle & "&" & c(2).Resize(h).Address
Next
P.Columns(14) = Evaluate(cle)
Intersect(P.Resize(h - 1), Q.EntireColumn).Interior.ColorIndex = 24
End Sub
Fichier (2).

Bonne journée.
 

Pièces jointes

  • Clé unique(2).xls
    37.5 KB · Affichages: 37

job75

XLDnaute Barbatruc
Re : création d'une clé unique via userform

Re,

On aura remarqué qu'au fichier (2) l'ordre de sélection des en-têtes intervient.

Si on veut l'éviter il faut tester toutes les en-têtes, dans l'ordre :

Code:
Private Sub CommandButton1_Click()
Dim P As Range, h&, Q As Range, cle$, c As Range
Set P = [A1].CurrentRegion.Offset(1).Resize(, 13)
h = P.Rows.Count
P.Columns(14).ClearContents 'RAZ
P.Interior.ColorIndex = xlNone 'RAZ
Set Q = Intersect(P.Rows(0), Selection)
If h = 1 Or Q Is Nothing Then Exit Sub
cle = """"""
For Each c In P.Rows(0).Cells
  If Not Intersect(c, Q) Is Nothing Then cle = cle & "&" & c(2).Resize(h).Address
Next
P.Columns(14) = Evaluate(cle)
Intersect(P.Resize(h - 1), Q.EntireColumn).Interior.ColorIndex = 24
End Sub
Fichier (3).

A+
 

Pièces jointes

  • Clé unique(3).xls
    42.5 KB · Affichages: 49

Discussions similaires

Réponses
10
Affichages
555
Réponses
10
Affichages
400