Pour un projet j'aimerais automatiser une création de réferences.
L'idée est qu'en appuyant sur un seul bouton, cela active une macro qui me créait toutes les références possibles.
Comme vous pouvez le voir sur la photo, j'ai plusieurs tableaux (qui évolueront surement au fur et à mesure du temps).
La photo suivante montre la construction d'une réference :
La réference sera au final de ce type là : SQA804V-2U3O3O1O/DO
Cela signifie que chaque tableau intervient une fois, sauf le tableau "Plaque" qui peut intervenir 1 à 4 fois en fonction du nombre de postes (tableau "Poste").
J'aurais d'abord voulu savoir si c'était quelque chose de réalisable, et auquel cas si vous pouviez me donner des pistes pour pouvoir m'en sortir.
N'hesitez pas à me demander plus d'informations si ce n'est pas assez clair.
Merci d'avance et bonne fin de semaine !
Bien à vous
A voir également:
Créer automatiquement une liste à partir de tableaux
bonjour,
souhaites-tu obtenir un long tableau, similaire à celui de la deuxième image, avec toutes les combinaisons possibles?
maitrises-tu le VBA? cherches-tu à l'apprendre?
commence peut-être à faire cela à partir des tableaux gamme et vis, cela t'aidera à faire cela progressivement.
L'idée est plutôt d'obtenir une colonne unique où chaque ligne correspond à une réference de type : "SQA804V-2U3O3O1O/DO" afin d'obtenir la totalité des références possibles.
Pour être honnete, non je ne maitrise pas VBA, mais le fait d'avoir déjà programmé dans d'autres languages me permet généralement de m'en sortir grâce à des recherches et à la magique option "enregistrer une macro".
A chaque nouveau projet, j'apprends de nouvelles fonctionnalités/fonctions de VBA que je réutilise ensuite lorsque j'en ai besoin.
Je pense que le type de logique est la suivante :
- Dans le tableau Gamme : Tant que la cellule n'est pas vide alors
- enregister la cellule actuelle dans une variable
- Dans le tableau Vis : Tant que la cellule n'est pas vide alors
- ajouter la cellule actuelle dans la variable
- Dans le tableau Largeur : Tant que la cellule n'est pas vide alors
- ajouter la cellule actuelle dans la variable
Je suis partie sur ça pour uniquement les plaques simples pour l'instant et sans la finition :
Sub CREER()
'
' CREER Macro
'
'
Dim clg As Range, derligg As Long, ligg As Long, nouvcelg As Range, ref As String
Dim clk As Range, derligk As Long, ligk As Long, nouvcelk As Range
Dim clo As Range, derligo As Long, ligo As Long, nouvcelo As Range
Dim cls As Range, derligs As Long, ligs As Long, nouvcels As Range
Dim clc As Range, derligc As Long, ligc As Long, nouvcelc As Range
Sheets("Plaque").Select
Set clg = [G3]
derligg = clg.End(xlDown).Row
Set nouvcelg = Cells(derligg + 1, 1)
For ligg = 2 To derligg
Set clk = [K3]
derligk = clk.End(xlDown).Row
Set nouvcelk = Cells(derligk + 1, 1)
For ligk = 2 To derligk
Set clo = [O3]
derligo = clo.End(xlDown).Row
Set nouvcelo = Cells(derligo + 1, 1)
For ligo = 2 To derligo
Set cls = [S3]
derligs = cls.End(xlDown).Row
Set nouvcels = Cells(derligs + 1, 1)
For ligs = 2 To derligs
Set clc = [C3]
derligc = clc.End(xlDown).Row
Set nouvcelc = Cells(derligc + 1, 1)
For ligc = 2 To derligc
ref = clg & clk & clo & cls & clc
Sheets("Création automatique de réferen").Select
Range("A2").Select
ActiveCell = ref
ActiveCell.Offset(1, 0).Range("A1").Select
Set clc = clc.Offset(1)
Next ligc
Set cls = cls.Offset(1)
Next ligs
Set clo = clo.Offset(1)
Next ligo
Set clk = clk.Offset(1)
Next ligk
Set clg = clg.Offset(1)
Next ligg
End Sub
Sub CREER()
'
' CREER Macro
'
'
Option Explicit
Dim clg As Range, derligg As Long, ligg As Long, nouvcelg As Range, ref As String
Dim clk As Range, derligk As Long, ligk As Long, nouvcelk As Range
Dim clo As Range, derligo As Long, ligo As Long, nouvcelo As Range
Dim cls As Range, derligs As Long, ligs As Long, nouvcels As Range
Dim clc As Range, derligc As Long, ligc As Long, nouvcelc As Range
Set clg = Sheets("Plaque").[G3]
derligg = clg.End(xlDown).Row
Set nouvcelg = Cells(derligg + 1, 1)
For ligg = 2 To derligg
Set clk = [K3]
derligk = clk.End(xlDown).Row
Set nouvcelk = Cells(derligk + 1, 1)
For ligk = 2 To derligk
Set clo = [O3]
derligo = clo.End(xlDown).Row
Set nouvcelo = Cells(derligo + 1, 1)
For ligo = 2 To derligo
Set cls = [S3]
derligs = cls.End(xlDown).Row
Set nouvcels = Cells(derligs + 1, 1)
For ligs = 2 To derligs
Set clc = [C3]
derligc = clc.End(xlDown).Row
Set nouvcelc = Cells(derligc + 1, 1)
For ligc = 2 To derligc
ref = clg & clk & clo & cls & clc
Sheets("Création automatique de réferen").[A2]
ActiveCell = ref
ActiveCell.Offset(1, 0).Range("A1").Select
Set clc = clc.Offset(1)
Next ligc
Set cls = cls.Offset(1)
Next ligs
Set clo = clo.Offset(1)
Next ligo
Set clk = clk.Offset(1)
Next ligk
Set clg = clg.Offset(1)
Next ligg
End Sub
L'OptionExplicit semble incorrect car cela m'affiche une "Compile error: Invalid inside procedure".
Sinon en enlevant cette première ligne j'obtiens l'erreur suivante :
'Run-time error '1004':
Même en le mettant au début cela me pose problème ..
Voilà le code :
Sub CREER()
'
' CREER Macro
'
'
Option Explicit
Dim rg As Range, ref As String, cible As Range
Dim rk As Range
Dim ro As Range
Dim rs As Range
Dim rc As Range
Dim rw As Range
Set cible = Sheets("Création automatique de réferen").[A2]
Set rg = Sheets("Plaque").[G3]
Do While rg <> ""
Set rk = Sheets("Plaque").[K3]
Do While rk <> ""
Set ro = Sheets("Plaque").[O3]
Do While ro <> ""
Set rs = Sheets("Plaque").[S3]
Do While rs <> ""
Set rc = Sheets("Plaque").[C3]
Do While Left(rc, 1) = "1"
Set rw = Sheets("Plaque").[W3]
Do While rw <> ""
ref = rg & rk & ro & rs & "-" & rc & "/" & rw
cible = ref
Set cible = cible.Offset(1)
Set rw = rw.Offset(1)
Loop
Set rc = rc.Offset(1)
Loop
Set rs = rs.Offset(1)
Loop
Set ro = ro.Offset(1)
Loop
Set rk = rk.Offset(1)
Loop
Set rg = rg.Offset(1)
Loop
End Sub
J'ai essayé d'ameliorer la version de vendredi, mais il semble que la partie :
Set rc = Sheets("Plaque").[C3]
Do While Left(rc, 1) = "1"
ne fonctionne pas. Sauriez-vous m'indiquer pourquoi ?
- Messages postés
-
239
- Date d'inscription
- jeudi 5 juillet 2012
- Statut
- Membre
- Dernière intervention
- 18 juillet 2021
7 > yg_beCela fonctionne merci beaucoup !
Je vais le continuer.
Par contre pas reussi à mettre l'Option Explicit, comme expliqué dans mon dernier message ..
- Messages postés
-
16443
- Date d'inscription
- lundi 9 juin 2008
- Statut
- Contributeur
- Dernière intervention
- 26 juillet 2021
880 > farreneit- Messages postés
-
239
- Date d'inscription
- jeudi 5 juillet 2012
- Statut
- Membre
- Dernière intervention
- 18 juillet 2021
7 > yg_beVoilà le code :
Sub CREER() ' ' CREER Macro ' ' Option Explicit Dim rg As Range, ref As String, cible As Range Dim rk As Range Dim ro As Range Dim rs As Range Dim rc As Range Dim rw As Range Set cible = Sheets("Création automatique de réferen").[A2] Set rg = Sheets("Plaque").[G3] Do While rg <> "" Set rk = Sheets("Plaque").[K3] Do While rk <> "" Set ro = Sheets("Plaque").[O3] Do While ro <> "" Set rs = Sheets("Plaque").[S3] Do While rs <> "" Set rc = Sheets("Plaque").[C3] Do While Left(rc, 1) = "1" Set rw = Sheets("Plaque").[W3] Do While rw <> "" ref = rg & rk & ro & rs & "-" & rc & "/" & rw cible = ref Set cible = cible.Offset(1) Set rw = rw.Offset(1) Loop Set rc = rc.Offset(1) Loop Set rs = rs.Offset(1) Loop Set ro = ro.Offset(1) Loop Set rk = rk.Offset(1) Loop Set rg = rg.Offset(1) Loop End SubJ'ai essayé d'ameliorer la version de vendredi, mais il semble que la partie :
Set rc = Sheets("Plaque").[C3] Do While Left(rc, 1) = "1"ne fonctionne pas. Sauriez-vous m'indiquer pourquoi ?
Merci encore pour votre aide !
- Messages postés
-
239
- Date d'inscription
- jeudi 5 juillet 2012
- Statut
- Membre
- Dernière intervention
- 18 juillet 2021
7 > farreneitPar contre toujours bloqué par l'Option Explicit ..
- Messages postés
-
16443
- Date d'inscription
- lundi 9 juin 2008
- Statut
- Contributeur
- Dernière intervention
- 26 juillet 2021
880 > farreneit