"Plantage" code : Amélioration - CODE VBA - LISTE et BASE DE DONNÉES

[Valentin]

Bonjour à tous,

Je fais une fois de plus appel à vous .... D'emblée merci à ceux qui s'intéresseront à l'amélioration du code que je vous propose ..

Alors voilà, je me suis fortement inspiré d'un code trouvé sur la toile, (Formation Excel VBA JB ->Listes cascade -> création de liste à partir d'une BD), permettant de faire des remplissages de cellules par sélection dans liste déroulante. Liste déroulante présentant des possibilités en fonction de valeurs présentes dans une autre cellule. (En l'occurrence provenant de liste également).

Je vous invite à jeter un Oeil au document ci-joint afin de mieux comprendre ma demande.

Le système crée une "Base de données" composée de différentes listes proposant les différentes possibilités en fonction des choix.

BD :


Liste
TV
RADIO
_TV1_


TV
PANASONIC
RADIO
PHILIPS
SONY
PANASONIC
_TV1_
Exception

PANASONIC
_TV1_
RADIO3
PHILIPS
RADIO1
RADIO2
RADIO3
SONY
RADIO2
PANASONIC
_TV1_
RADIO3
Exception
_L5_

_TV1_
10"
20"
30"
RADIO3
Jaune
Rouge
Bleu
RADIO1
Rouge
RADIO2
Rouge
Jaune
RADIO3
Jaune
Rouge
Bleu
RADIO2
Rouge
Jaune
_TV1_
10"
20"
30"
RADIO3
Jaune
Rouge
Bleu
_L5_
Noir




Il existe plusieurs soucis. Le premier est que si un type (= 3 différents ici : "TV" "RADIO" "_TV1_") est égal à un modèle, c'est le cas de "_TV1_", alors la liste proposera (10" 20" 30") à la place de exception.

Ceci est le plus gros soucis, les autres sont des soucis de non acceptation de certains caractères du genre "()-" .. Ou une erreur donnée si le mot ne commence pas par un underscore ou une lettre ...


Je suis conscient que j'ai un peu de mal à exprimer mon soucis clairement, mais je vous invite à regarder la pièce jointe qui peut être vous éclairera.


En résumé :

Le but de ce programme est de pouvoir créer des liste de choix dans des cellules qui soit en fonction des autres choix. (Exemple :"TV" ; "PANASONIC" ne doit pas proposer les mêmes choix que "RADIO" ; "PANASONIC").

Je vous remercies toutes et tous,

Valentin

Sub CreeListeBD()
 colBD = 1
 colListe = 8
 Set f = Sheets("bd")
 ligne = 1
 f.Cells(ligne + 1, colListe).Resize(1000, 10).Clear
 Set mondico = CreateObject("Scripting.Dictionary")
 For Each c In Range(f.Cells(2, colBD), f.Cells(65000, colBD).End(xlUp))
   mondico(c.Value) = c.Value
 Next c
 f.Cells(ligne, colListe) = "Liste"
 f.Cells(ligne, colListe).Font.Bold = True
 f.Cells(ligne + 1, colListe).Resize(mondico.Count) = Application.Transpose(mondico.items)
 ActiveWorkbook.Names.Add Name:="Liste", RefersTo:=f.Cells(ligne + 1, colListe).Resize(mondico.Count)
 '---- niv 2,3,..
 For niv = 2 To 3    ' adapter le nombre de niveaux
    colBD = colBD + 1
    colListe = colListe + 2
    ligne = 1
    For Each c In Range(f.Cells(2, colListe - 2), f.Cells(65000, colListe - 2).End(xlUp))
     If c <> "" And c.Font.Bold <> True Then
      Set mondico = CreateObject("Scripting.Dictionary")
      For Each d In Range(f.Cells(2, colBD), f.Cells(65000, colBD).End(xlUp))
        If d.Offset(, -1) = c Then mondico(d.Value) = d.Value
      Next d
      f.Cells(ligne, colListe) = c
      f.Cells(ligne, colListe).Font.Bold = True
      f.Cells(ligne + 1, colListe).Resize(mondico.Count) = Application.Transpose(mondico.items)
      ActiveWorkbook.Names.Add Name:=Replace(c, " ", "_"), RefersTo:=f.Cells(ligne + 1, colListe).Resize(mondico.Count)
      ligne = ligne + mondico.Count + 1
     End If
    Next c
 Next niv
End Sub

 

[Valentin]

Re : Amélioration - CODE VBA - LISTE et BASE DE DONNÉES - [RESOLU]

Solution trouvée sur le site de Jacques Boisgontier : http://boisgontierjacques.free.fr/fichiers/DonneesValidation/DVCascadeMenu4Niv.xls

Bonne journée à tous,

 

[Valentin]

Re : Amélioration - CODE VBA - LISTE et BASE DE DONNÉES - [RESOLU]

Bonjour, re-bonjour,

Je ne parviens pas à faire fonctionner le code suivant provenant du code contenu dans le fichier : FICHIER EXCEL

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Set f = Sheets("BD")
  Application.ScreenUpdating = False
  If Not Intersect([A2:A10], Target) Is Nothing And Target.Count = 1 Then
    f.[n2] = Empty
    f.[A1:D1000].AdvancedFilter Action:=xlFilterCopy, _
      CriteriaRange:=f.[N1:N2], CopyToRange:=f.[G1], Unique:=True
  End If
  If Not Intersect([B2:B10], Target) Is Nothing And Target.Count = 1 Then
     f.[n2] = Target.Offset(0, -1)
     f.[o2] = Empty
     f.[A1:D1000].AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=f.[N1:O2], CopyToRange:=f.[H1], Unique:=True
  End If
  If Not Intersect([C2:C10], Target) Is Nothing And Target.Count = 1 Then
    f.[n2] = Target.Offset(0, -2)
    f.[o2] = Target.Offset(0, -1)
    f.[p2] = Empty
    f.[A1:D1000].AdvancedFilter Action:=xlFilterCopy, _
      CriteriaRange:=f.[N1:P2], CopyToRange:=f.[I1], Unique:=True
   End If
   If Not Intersect([d2:d10], Target) Is Nothing And Target.Count = 1 Then
    f.[n2] = Target.Offset(0, -3)
    f.[o2] = Target.Offset(0, -2)
    f.[p2] = Target.Offset(0, -1)
    f.[q2] = Empty
    f.[A1:D1000].AdvancedFilter Action:=xlFilterCopy, _
      CriteriaRange:=f.[N1:q2], CopyToRange:=f.[J1], Unique:=True
   End If
End Sub

La liste déroulante contenu dans "COMBO" fonctionne correctement pour ma part, mais je ne parviens pas à utiliser les listes déroulantes dans l'onglet DV si j'utilise plus de 10 lignes ..

 

[Staple1600]

Re : Amélioration - CODE VBA - LISTE et BASE DE DONNÉES

Bonsoir

10 lignes ?
Hummmmm voyons cela ...
If Not Intersect([A2:A10], Target) Is Nothing And Target.Count = 1 Then

Ah oui d'accord, je vois

 

[Valentin]

Re : Amélioration - CODE VBA - LISTE et BASE DE DONNÉES

C'est en effet ce que j'ai fait mais ça na pas fonctionné ... (je l'ai également fait pour B, C et D bien entendu ..)

 

[Valentin]

Re : Amélioration - CODE VBA - LISTE et BASE DE DONNÉES

C'est résolu, mais je ne sais pas comment, j'avais chipoté à d'autre partie du code avant de m'occuper de ça et je devais avoir tout chamboulé ..

En reprenant le fichier "vierge" de toutes mes modifications et en apportant votre éclaircissement, j'arrive à le faire fonctionner.

Merci Staple

Bonne journée,


Ps : Dur dur d'apprendre le VBA ... Mais on a rien sans mal hein ^^

 

[Valentin]

Re : Amélioration - CODE VBA - LISTE et BASE DE DONNÉES

Bonjour,

J'ai sans le vouloir bien sûr ^^ fait planté le fichier. Comment ? En incrémentant une cellule avec liste de validation vers une autre cellule avec liste de validation. Le soucis c'est que la valeur contenait des chiffres et a donc fait "+1". Valeur n'existant pas dans la proposition de liste de validation..

Ma question : comment refaire fonctionner le fichier ?

Merci à tous,

Je joints un fichier planté et 1 fichier non planté que vous pouvez faire planter pour voir ce qu'il se passe

 

[Valentin]

Re : "Plantage" code : Amélioration - CODE VBA - LISTE et BASE DE DONNÉES

J'ai trouvé une solution mais elle n'est pas des meilleurs et relativement contraignante : Re-démarrer le PC ...

Quelqu'un aurait une solution ne nécéssitant pas de re-démarrage ?

 

[MJ13]

Re : "Plantage" code : Amélioration - CODE VBA - LISTE et BASE DE DONNÉES

Bonjour Valentin, Jean-Marie

J'ai trouvé une solution mais elle n'est pas des meilleurs et relativement contraignante : Re-démarrer le PC ...

Quelqu'un aurait une solution ne nécéssitant pas de re-démarrage ?​

Le mieux est de débugger ton programme et de supprimer l'instruction qui fait planter ton fichier .

 

[Valentin]

Re : "Plantage" code : Amélioration - CODE VBA - LISTE et BASE DE DONNÉES

Bonjour MJ13,

Le mieux est de débugger ton programme et de supprimer l'instruction qui fait planter ton fichier .

C'est là que j'appelle à l'aide ^^ (Je suis débutant sous VBA et ce programme à été trouvé sur le site de Jacques Boisgontier .. Donc je ne maitrise pas tout à fait la chose .. )

 

[MJ13]

Re : "Plantage" code : Amélioration - CODE VBA - LISTE et BASE DE DONNÉES

Re

Je suis débutant sous VBA et ce programme à été trouvé sur le site de Jacques Boisgontier .. Donc je ne maitrise pas tout à fait la chose ..

Le problème, c'est que je n'ai pas réussi à le faire planter. C'est comme souvent, un problème d'explications pas très claires .

 

[Compte Supprimé 979]

Re : "Plantage" code : Amélioration - CODE VBA - LISTE et BASE DE DONNÉES

Bonjour le fil
Bonjour MJ13, Staple1600

Même chose pour moi, cela fonctionne parfaitement ... à priori

A+

 

[Valentin]

Re : "Plantage" code : Amélioration - CODE VBA - LISTE et BASE DE DONNÉES

Bonjour à tous,

Merci à vous de vous intéressez à mon soucis

J'ai réalisé une petite vidéo montrant mon soucis, peut-être celui-ci vient-il de mon pc ?

Video ici (avi)

Bien à vous,

Valentin

 

[Compte Supprimé 979]

Re : "Plantage" code : Amélioration - CODE VBA - LISTE et BASE DE DONNÉES

Re,

Normal le plantage aux vues de ta vidéo, tu fais une recopie vers le bas d'une cellule en colonne B
alors que la colonne A ne contient rien !?

Avec

On Error Resume Next

ca à l'air de tourner

A+

 

[Valentin]

Re : "Plantage" code : Amélioration - CODE VBA - LISTE et BASE DE DONNÉES

Re,

Normal le plantage aux vues de ta vidéo, tu fais une recopie vers le bas d'une cellule en colonne B
alors que la colonne A ne contient rien !?

Oui en effet, le plantage est normal mais ce n'est pas une opération voulue que celle-là, c'est parfois par fausse manip que cela arrive .. Donc je voulais trouver une solution pour rattraper le problème au cas où il se présente ..

Et vous avez trouvé =D Merci à vous,

Bonne journée !!! Et bonnes fêtes de fin d'années !