XL 2013 <Résolu> Incrémenter une base de donées

[WTF]

Bonjour le forum,
Je viens demander un peu d'aide aux spécialistes...

J'ai un fichier avec 2 onglets :
- sur l'onglet 1 (base) : une liste de produits
- sur l'onglet 2 : une base de données que je veux constituer

Le principe est quand on sélectionne un produit dans l'onglet 1, l'onglet 2 se rempli avec les caractéristiques du produit.
Exemple en PJ :
Quand je coche Produit 1 : bleu + vert
je veux que sur l'onglet 2 s'affiche :
- Produit 1 - Bleu
- Produit 1 - Vert
Si rien n'est coché dans la liste, rien n'apparait dans l'onglet 2.

Merci pour votre aide.

 

[gosselien]

Bonjour,

puisque personne ne se lance, j'y vais de mon code vba très imparfait (je ne sais pas utiliser le redim preserve et le mot produit se recopie 6 x ) mais en gros , ça semble fonctionner ..... si j'ai compris ton problème !!!
Il y aura bien un spécialiste qui donnera une meilleur version ou qui améliorera mon code

P.

 

[WTF]

Bonjour Gosselien,
Merci de t'y être essayé.
Un grand pas pour moi... même si du coup il reste des bug que je ne sais pas résoudre.
Ca avance....

 

[Dugenou]

Bonjour,
Un essai par formules (matricielles) : si le nb de lignes à traiter est beaucoup plus important : risque de temps de calcul élevé.
Si ça te convient j’expliquerai le détail des formules.

Cordialement

 

[gosselien]

Une version améliorée sauf pour les redim ...

en VBA si bcp de données sinon voir par formules proposé par Dugenou que je salue

Sub Croix2()
Dim a()
Dim t()
Dim mMax
Dim Z
Set ws1 = Sheets("Base"): Set ws2 = Sheets("Sheet1")
Set titre = ws1.[B23:C23]
last = ws1.[B65000].End(xlUp).Row
' selection du tableau sans les titres
ws1.Range("B23").CurrentRegion.Offset(1).Resize(Range("B23").CurrentRegion.Rows.Count - 1, 8).Select
a = Selection.Value ' tableau
ReDim Preserve t(1 To 200, 1 To 3) ' à revoir, je rame avec les tableaux !!!
' effacer les colonnes A-B-C de la feuille 2
ws2.[A:C].ClearContents
li = 1
' on prends les donnes de la colonne 3 à 8
For col = 3 To 8
For i = LBound(a) To UBound(a)
  If a(i, col) <> "" Then
     t(li, 1) = a(i, 1) ' données du tableau dans tableau provisoire T
     t(li, 2) = a(i, 2)
     t(li, 3) = Cells(23, col + 1) ' titre de la ligne 23
     li = li + 1
  End If
Next i
Next col
Debug.Print UBound(t)
ws2.[A3].Resize(UBound(t), 3) = t
' ajout des titres en feuille 2
titre.Copy Destination:=ws2.[A2]: ws2.[C2].Value = "Couleur"
End Sub

 

[WTF]

Top Dugenou,
La liste ne devrait pas être trop importante, donc la version formule est tout à fait possible.
J'avoue que je veux bien que tu me les explique, parce que je ne pensais pas pouvoir réussir sans macro!!

Merci Gosselien pour ta macro. Comme rien ne se perd, je la garde sous le coude.

 

[Dugenou]

Bonjour,
Voici le fichier avec commentaires : n'hésites pas à revenir sur ce fil si des éléments sont pas clairs ou pour adapter à la vraie vie.

Cordialement