Pré-remplir un tableau en fonction d'une liste
Bonjour,
J'ai besoin de vos lumière pour réaliser ceci:
Je souhaiterai remplir un tableau en fonction d'une liste.
Je m'explique : j'ai un tableau de liste où il y a deux types de mangas Shonen et Shojo on peut choisir un mangas dans une des deux types de mangas au fur et à mesure qu'on choisi des mangas l'utilisateur sera limité par le nombre de mangas choisi (cf tableau).
Les mangas choisis seront utilisé pour remplir un tableau si je choisis one piece et naruto cela va me générer trois colonnes qui auront comme intitulé Anime- Scan et Film d'animation, mais pour certain sa sera quatre colonnes(= comme pour DB ) selon le mangas choisi la quatrième colonne aura comme intitulé Bande dessiné.
merci de votre aide
Re_Bonjour,
alors j'ai réussi à créer une liste et et les donnée de la liste sont sur une autre feuille mais le remplissage automatiquement du tableaux est ma première difficulté.
aider moi please.
Re,
En faites je souhaite maintenant savoir comment récupérer un nom depuis une liste déroulante choisie
merci de me répondre
Bonjour
A quoi te servent les réponses si tu ne les utilises pas ?
Dans le code rien de ce que je t'avais proposé
Cà encourage à aider
bonjour Bnazai64,
ton aide m'a aidé mais c'est autre chose que je suis en train de faire.
je n'utilise plus de formulaire mais de plusieurs liste dans une plage donnée sur la feuille2.
je sais comment créer un tableau depuis une liste :
If Range("H7:J7").Text <> "0" Then
'I. pour chaque nom choisi dans la liste déroulante
'I.1 Fusion de 3 cellules pour le Nom du mangas
'I.1.1 Sélection de la dernière cellule
Selection.Copy Destination:=Range("J7")
'I.1.2 Sélection des trois cellules
Range("H7:J7").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Fusion des cellules
Selection.Merge
'selection des trois cellules
Range("H7:J7").Select
'ajout les types de mangas
ActiveCell.FormulaR1C1 = "=R[-3]C[-6]"
Range("H8").Select
'ecris Anime
ActiveCell.FormulaR1C1 = "Anime"
Range("I8").Select
'ecris Scan
ActiveCell.FormulaR1C1 = "Scan"
Range("J8").Select
'écris Film Anime
ActiveCell.FormulaR1C1 = "Film Anime"
Range("K7:M7").Select
Else
'suppresion vers la gauche
Range("H7:J8").Select
Selection.Delete Shift:=xlToLeft
End Ifmais le soucis ce n'est pas il y a toujours un truc qui manque dans mon code pour optimiser mon projet.
par exemple quand j'ai créé mes tableaux il faut que je mette à N+1 de la dernière ligne du tableau créé, les totaux pour connaitre le nombre de mangas ou de scan ou de film téléchargé c'est à dire somme=(colonne anime:colonne scan:colonne film anime).
mais avant je dois demander combien de sorte de seeder ou leecher il y a et je créer le nombre de ligne qu'il y a de seeder ou de leecher.
voilà désolé si je t'ai offenser en postant ce message gomen
je te remercie encore beaucoup
désolé encore banzai64
Bonjour Forumeuret EXCELEUR(SE),
je ne comprend pas cette erreur quelqu'un peu m'expliquer à travers mon code
'variable
Dim NbLigne As Integer
Dim Colonne As Integer
Dim Ligne As Long
Dim cpt As Integer
Dim NuDerniere_Ligne As Long
'initialisation des variables
Colonne = 2
cpt = 0
'récupération du nombre de ligne dans le tableau
NbLigne = Cells(Rows.Count, Colonne).End(xlUp).Row - 1
'récupération de la dernière ligne du tableau
NuDerniere_Ligne = Cells(Rows.Count, Colonne).End(xlUp).Row + 1
' MsgBox NuDerniere_Ligne & NbLigne
'si le Nom du Mangas esy choisi alors copier la dernierère ligne et
'la mettre à la ligne après ainsi de suite jusqu'à que le nombre de ligne soit dépassé
If Range("B4").Text <> "" Then
'pour le compteur vas jusqu'au nombre ligne les copies les une sous les autres
For cpt = 1 To NbLigne
Range(Cells(NuDerniere_Ligne - cpt, Colonne - 1), Cells(NuDerniere_Ligne - cpt, Colonne)).Select
Selection.AutoFill Destination:=Range(Cells(NuDerniere_Ligne, Colonne - 1), Cells(NuDerniere_Ligne + cpt, Colonne)), Type:=xlFillDefault
Range(Cells(NuDerniere_Ligne + cpt, Colonne - 1), Cells(NuDerniere_Ligne, Colonne)).Select
Next
'incrémentation cpt
cpt = cpt + 1
End Ifje vous le fichiers aussi
cordialement
re,
excusez moi j'ai oublié de mettre l'erreur :
Erreur d'exécution '1004'
La méthode AutoFill de la classe Range a échoué.
le code se trouve juste sur le post précédent
merci de me répondre
je sèche vraiment
Re,
Je suis allé encore trop vite pour l'erreur il me sur ligne cette ligne:
Selection.AutoFill Destination:=Range(Cells(NuDerniere_Ligne, Colonne - 1), Cells(NuDerniere_Ligne + cpt, Colonne)), Type:=xlFillDefault
Bonjour
Je sèche vraiment voilà trois jours j'essaie de faire juste un copier coller d'un tableau de liste et je n'arrive pas à le faire.
Car à chaque fois que l'utilisateur choisi quelques chose dans une liste sa incrémente une nouvelle ligne composé d'une liste et ainsi de suite jusqu'à l'utilisateur à fini mais je n'arrive pas à le faire quelqu'un aurait une idée je sèche VRAIMENT.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim NbLigne As Integer
Dim Colonne As Integer
Dim NuDerniere_Ligne As Long
Dim cpt As Integer
Dim rg As Range
Colonne = 2
NuDerniere_Ligne = Cells(Rows.Count, Colonne).End(xlUp).Row + 1
NbLigne = Cells(Rows.Count, Colonne).End(xlUp).Row - 1
If Range("B4") <> "" Then
For cpt = 0 To NbLigne
Range(Cells(NbLigne, Colonne - 1), Cells(NbLigne, Colonne)).Copy Range(Cells(NbLigne + 10, Colonne - 1), Cells(NuDerniere_Ligne + 10, Colonne))
Next
cpt = cpt + 1
'Range("B4") = ""
End If
End SubBonjour ;
j'ai trouvé : D super content mais je suis pas au bout de ma peine.
Comment dire si une cellule de la colonne B "juste pour les listes" est différents ""
je veux dire un truc comme
If Range("colonne que les liste <>"" thenpour la solution de précédent problème c'est :
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'variable
Dim NbLigne As Integer
Dim Colonne As Integer
Dim NuDerniere_Ligne As Long
' initialisation des variables
Colonne = 2
cpt = 0
' récupération du nombre de ligne dans le tableau
NbLigne = Cells(Rows.Count, Colonne).End(xlUp).Row - 1
' récupération de la dernière ligne du tableau
NuDerniere_Ligne = Cells(Rows.Count, Colonne).End(xlUp).Row + 1
If Range("") <> "" And cpt < 2 Then
Range(Cells(NbLigne, Colonne - 1), Cells(NuDerniere_Ligne, Colonne)).Copy Range(Cells(NbLigne + 1, Colonne - 1), Cells(NuDerniere_Ligne + 1, Colonne))
End If
Range("B4") = ""
End Subvoilà.
J'espère j'aurai une réponse
Bonjour
Je vais peut-être dire des bêtises
Pourquoi tu t'agaces à vouloir insérer des lignes (c'est la galère à faire - J'ai essayé mais il y à plein de contraintes - et je pense que la suppression doit être envisagée)
Fais un tableau avec le nombre de ligne maxi pour SHONEN et le nombre maxi pour SHÔJO et comme cela ce problème est réglé
Bonjour,
Je sais (et j'aurai du fermer ma gueule quand je l'ai proposé), si tu veux cette liste comprend 7 familles et dans chaque famille tu as droit de choisir 6 noms pas plus.
Je suis en train de le faire. je dois juste trouver le nombre de ligne que contient mon tableau(qui change à chaque fois j'ajoute un nom mais il y a une limite) la dernière ligne sa je l'ai trouvé par ce petit bout de code:
IDerLigne = Cells(Rows.Count, Colonne).End(xlUp).RowEt oui, il y a bien une suppression. sa c'est plus dur car je sais combien il y a de cases vides c'est à dire trois pour cette exemple ( et je sais où elle se trouve donc je fais un select case pour sa; ce qui n'est pas évident) car je galère à faire les ajout. mais si je n'arrive pas avant mardi je laisse tomber et je fais ce que tu as dis c'est dix fois plus simple même si c'est moche niveau design.
En, tous cas merci d'avoir jeter un oeil sur mon cas.
Sa fait toujours plaisir qu'il y a quelques personnes qui jettent un œil et donnent leurs opinions
Bonjour
C'est compliqué
Je ne crois pas que j'irais plus loin
A tester
Bonsoir banzai64,
merci de ta contribution.Mais je vais trouver sa c'est sur. J'ai déjà la suppression grâce à la boucle" un pour chaque"
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''SI SUPPRESSION D'UNE LIGNE DANS UNE LISTE ALORS JE DECREMENTE''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'On affecte la plage de cellules à la colonne E
'à la variable Cel
For Cpt1 = 6 To IDerLigne
' MsgBox IDerLigne
Set cel3 = Cells(Cpt1, Colonne + 1)
'Pour chaque cellule de la plage de cellule
For Each Cel4 In cel3
If Cel4 = "" Then
If Cells(Cpt1, Colonne) = "" Then
' Cells(Cpt1, Colonne + 2) = "effacer"
Range(Cells(Cpt1 + 1, Colonne), Cells(IDerLigne, Colonne + 1)).Copy Range(Cells(Cpt1, Colonne), Cells(IDerLigne - 1, Colonne + 1))
' Range(Cells(IDerLigne, Colonne), Cells(IDerLigne, Colonne + 1)) = ""
' Range(Cells(IDerLigne + 1, Colonne), Cells(IDerLigne + 1, Colonne + 1)).Select
' selection.Delete Shift:=xlUp
End If
' Range(Cells(IDerLigne, Colonne), Cells(IDerLigne, Colonne + 1)).Select
' selection.Delete Shift:=xlUp
' MsgBox "dois je effacer" & Cpt
End If
Next
Next
Cpt1 = Cpt1 + 1Et me reste l'ajout mais le tiens est super bien fais.
C'est excellent ce que tu as fait.Il me reste encore pas mal de chose à faire merci
Merci beaucoup.
Purer en une journée tu as fais sa ouah impressionné.
tu veux bien être mon Seinsei
Je Valide ce post.Mais il me reste plein de choses à faire encore donc si tu es là pour me donner des conseils sa sera cool.
merci Beaucoup
Bonjour
Tu peux continuer suivant ton idée
Je ne suis pas "the best" loin s'en faut
Tu trouveras sur ce site tous les conseils dont tu as besoin
bonjour à tous ,
Pour sa intéresse l'ajout et la suppression d'un tableau suivant ce qu'on choisit très simple et optimiser comme code, je pense je peux encore l'optimiser encore plus.
voici le code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''CONSTRUCTION DES TABLEAU AUTOMATIQUEMENT SELON LE CHOIX DES LISTES'''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'variable
Dim IPreLigne As Integer
Dim IDerLigne As Long
Dim NbLigne As Integer
Dim Colonne As Integer
Dim Cpt As Integer
Dim Cpt1 As Integer
Dim NbLigAjT As Integer
Dim NbCellVide As Integer
Dim cel1 As Range, Cel2 As Range
Dim cel3 As Range, Cel4 As Range
Dim chaine As String
' initialisation des variables
IPreLigne = 7
Colonne = 4
NbLigAjT = 1
NbCellVide = 0
Cpt = 7
Set cel1 = Cells(Cpt, Colonne + 1)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''RECUPERATIONS DES VALEUR ET AJOUT UNE LIGNE AUX LISTES ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' récupération du nombre de ligne dans le tableau à partir de la cinquième ligne
NbLigne = Cells(Rows.Count, Colonne).End(xlUp).Row - 5
' récupération de la dernière ligne du tableau
IDerLigne = Cells(Rows.Count, Colonne).End(xlUp).Row
' MsgBox NbLigne & IDerLigne
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''remplissage du tableau''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'On affecte la plage de cellules à la colonne E
'à la variable Cel
For Cpt = 7 To IDerLigne
' MsgBox IDerLigne
Set cel1 = Cells(Cpt, Colonne + 1)
If Cells(Cpt, Colonne + 1) <> "" Then
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''une autre condition sinon remplissage automatique qu'une culture; si cellule = 0 pas de remplissage sinon remplissage''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Cells(Cpt, Colonne) = 0 Then
Else
'je sauvegarde le texte car elle sera effacé au premier tour
chaine = Cells(Cpt, Colonne + 1).Text
'je copie la première colone et je colle sur elle même à n+1
Range(Cells(Cpt, Colonne), Cells(IDerLigne, Colonne)).Copy Range(Cells(Cpt + 1, Colonne), Cells(IDerLigne + 1, Colonne))
'j'efface la sélection
Cells(Cpt, Colonne + 1) = ""
'je copie la deuxième colonne et je la colonne sur elle même à n+1
Range(Cells(Cpt, Colonne + 1), Cells(IDerLigne, Colonne + 1)).Copy Range(Cells(Cpt + 1, Colonne + 1), Cells(IDerLigne + 1, Colonne + 1))
'j'affecte le texte à n+1
Cells(Cpt + 1, Colonne + 1) = chaine
'j'efface la sélection
Cells(Cpt, Colonne + 1) = ""
'j'efface la sélection
Cells(Cpt + 1, Colonne) = ""
Exit Sub
End If
End If
Next
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''SI SUPPRESSION D'UNE LIGNE DANS UNE LISTE ALORS JE DECREMENTE''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'On affecte la plage de cellules à la colonne E
'
'à la variable Cel
Cpt1 = 0
For Cpt1 = 6 To IDerLigne - 1
' MsgBox IDerLigne
Set cel3 = Cells(Cpt1, Colonne + 1)
'Pour chaque cellule de la plage de cellule
For Each Cel4 In cel3
If Cells(Cpt1, Colonne) = "" And Cells(Cpt1, Colonne + 1) = 0 Then
' Cells(Cpt1, Colonne + 2) = "effacer"
' je copie la première colone et je colle sur elle même à n-1
Range(Cells(Cpt1 + 1, Colonne), Cells(IDerLigne + 1, Colonne)).Copy Range(Cells(Cpt1, Colonne), Cells(IDerLigne, Colonne))
' je copie la deuxième colonne et je la colonne sur elle même à n-1
Range(Cells(Cpt1 + 1, Colonne + 1), Cells(IDerLigne + 1, Colonne + 1)).Copy Range(Cells(Cpt1, Colonne + 1), Cells(IDerLigne, Colonne + 1))
End If
Next
Next
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End Subje vous joins aussi le fichier mais bon sa peut d'importance les variables que vous devez changer sont la colonne et cpt( =l'index de la première ligne de la liste).
voilà merci pour l'aide que vous m'avez apporté
Banzai64 ta solution ne me convenait pas, car tu faisais en fonction des liste de validation, car je compte laisser autant de liste que de type de mangas c'est à dire 7 liste et à chaque ajout ça ne doit pas ajouter une liste mais juste le nom du choix. Et à chaque fois qu'une ligne est ajoutée je fusionne la ligne avec son types de mangas.Je suis en train de le faire mais sa devrait pas trop me demander de temps, en fin j'espère
merci de votre passage
PS:si vous pouvez l'optimiser sa serait bien de le me monttrer