Bonjour, 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

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.

Créer automatiquement une liste à partir de tableaux [Résolu]

farreneit Messages postés 282 Date d'inscription jeudi 5 juillet 2012 Statut Membre Dernière intervention 13 janvier 2023 10
2 juil. 2021 à 10:23

Tout d'abord merci pour ta réponse très rapide !

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

etc

C'est bien ça ?

yg_be Messages postés 21119 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 6 février 2023 1 308 > farreneit Messages postés 282 Date d'inscription jeudi 5 juillet 2012 Statut Membre Dernière intervention 13 janvier 2023
2 juil. 2021 à 10:59

bonne idée, essaie cela.

farreneit Messages postés 282 Date d'inscription jeudi 5 juillet 2012 Statut Membre Dernière intervention 13 janvier 2023 10 > yg_be Messages postés 21119 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 6 février 2023
2 juil. 2021 à 17:18

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

J'obtiens malheureusement une erreur à :

Set nouvcelc = Cells(derligc + 1, 1)

Comment est-ce que cela vous semble ?

Merci d'avance !

yg_be Messages postés 21119 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 6 février 2023 1 308 > farreneit Messages postés 282 Date d'inscription jeudi 5 juillet 2012 Statut Membre Dernière intervention 13 janvier 2023
2 juil. 2021 à 17:23

il faut éviter d'utiliser select.
au lieu de

Sheets("Plaque").Select
Set clg = [G3]

ceci est mieux

Set clg = Sheets("Plaque").[G3]

il est recommandé d'ajouter

option explicit

en début de module, ce qui force à déclarer les variables.

quel est le message d'erreur?

farreneit Messages postés 282 Date d'inscription jeudi 5 juillet 2012 Statut Membre Dernière intervention 13 janvier 2023 10 > yg_be Messages postés 21119 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 6 février 2023
2 juil. 2021 à 17:35

Merci pour ces conseils, voilà le nouveau code :

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':

Application-defined or object-defined error'

yg_be Messages postés 21119 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 6 février 2023 1 308 > farreneit Messages postés 282 Date d'inscription jeudi 5 juillet 2012 Statut Membre Dernière intervention 13 janvier 2023
2 juil. 2021 à 17:50

option explicit

doit être en début de module, donc en haut de la page.

yg_be Messages postés 21119 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 6 février 2023 1 308 > farreneit Messages postés 282 Date d'inscription jeudi 5 juillet 2012 Statut Membre Dernière intervention 13 janvier 2023
2 juil. 2021 à 17:57

l'erreur est sur quelle instruction?
si c'est sur

Set nouvcelc = Cells(derligc + 1, 1)

il est préférable de toujours spécifier la feuille, donc:

Set nouvcelc = Sheets("?").Cells(derligc + 1, 1)

ou bien

dim w1 as worksheet
set w1 = Sheets("?")
Set nouvcelc = w1.Cells(derligc + 1, 1)

A quoi sert cette instruction?

yg_be Messages postés 21119 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 6 février 2023 1 308 > farreneit Messages postés 282 Date d'inscription jeudi 5 juillet 2012 Statut Membre Dernière intervention 13 janvier 2023
2 juil. 2021 à 17:59

je vois encore un

select

.

yg_be Messages postés 21119 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 6 février 2023 1 308 > farreneit Messages postés 282 Date d'inscription jeudi 5 juillet 2012 Statut Membre Dernière intervention 13 janvier 2023
2 juil. 2021 à 17:35

je ferais plutôt les boucles ainsi, pour parcourir les tableaux:

Dim rg As Range
Set rg = [s2]
Do While rg <> ""
    ' ...
    Set rg = rg.Offset(1)
Loop

et, afin d'enregistrer la référence, au lieu de

                    Sheets("Création automatique de réferen").Select
                    Range("A2").Select
                    ActiveCell = ref
                    ActiveCell.Offset(1, 0).Range("A1").Select

je ferais

dim cible as range
set cible=Sheets("Création automatique de réferen").[A2]
' ...
cible=ref
set cible=cible.offset(1)

farreneit Messages postés 282 Date d'inscription jeudi 5 juillet 2012 Statut Membre Dernière intervention 13 janvier 2023 10 > yg_be Messages postés 21119 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 6 février 2023
2 juil. 2021 à 18:10

Voici mon code :

Sub CREER()
'
' CREER Macro
'

'



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


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 rc <> ""
    
                    ref = rg & rk & ro & rs & rc
                    cible = ref
                    
                    Set cible = cible.Offset(1)
                
                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

Cela fonctionne merci beaucoup !

Je vais le continuer.

Par contre pas reussi à mettre l'Option Explicit, comme expliqué dans mon dernier message ..

yg_be Messages postés 21119 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 6 février 2023 1 308 > farreneit Messages postés 282 Date d'inscription jeudi 5 juillet 2012 Statut Membre Dernière intervention 13 janvier 2023
2 juil. 2021 à 18:24

option explicit doit se trouver tout en haut de la page de code.

farreneit Messages postés 282 Date d'inscription jeudi 5 juillet 2012 Statut Membre Dernière intervention 13 janvier 2023 10 > yg_be Messages postés 21119 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 6 février 2023
5 juil. 2021 à 12:30

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 ?

Merci encore pour votre aide !

farreneit Messages postés 282 Date d'inscription jeudi 5 juillet 2012 Statut Membre Dernière intervention 13 janvier 2023 10 > farreneit Messages postés 282 Date d'inscription jeudi 5 juillet 2012 Statut Membre Dernière intervention 13 janvier 2023
5 juil. 2021 à 15:08

Erreur bête de ma part pour la deuxième partie de mon message ..

Par contre toujours bloqué par l'Option Explicit ..

yg_be Messages postés 21119 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 6 février 2023 1 308 > farreneit Messages postés 282 Date d'inscription jeudi 5 juillet 2012 Statut Membre Dernière intervention 13 janvier 2023
5 juil. 2021 à 19:21

option explicit doit être en haut du module, en haut de la page, en haut du texte, avant toutes les autres instructions, donc hors de la sub.

Créer automatiquement une liste à partir de tableaux

1 réponse

Newsletters