Planning sur semaine glissante, ouverture USF trop longue

piga25 · 5 Mars 2015

Bonjour,

Je suis devant une situation bizarre
Lors de la conception du fichier, l'ouverture de l'Userform1 se faisait normalement, puis après quelques modifications dans les codes pour trouver la valeur d'une plage variable (liste de la combobox2), voila qu'il met énormément de temps pour s'ouvrir.
Par contre je suis incapable de dire le changement qui a procédé à cela.
Est-ce le nombre de : CreateObject("Scripting.Dictionary")
Pour la combobox1 la liste a intégrer est nommée : Client

Pour une fois que je commençais à comprendre les codes que je mettais, voilà que je suis totalement largué.
Merci

piga25 · 5 Mars 2015

Re : Planning sur semaine glissante, ouverture USF trop longue

RE,

Oups pour ceux qui n'ont pas 2010.
voici les codes:

Code:

Private Sub UserForm_Initialize()
Dim f
   Set f = Sheets("Liste")
   Me.ComboBox1 = ActiveCell().Value
   Set mondico = CreateObject("Scripting.Dictionary")
   For Each c In f.[client]
   mondico(c.Value) = ""
   Next c
   Me.ComboBox1.AddItem ""
   For Each c In mondico.keys
     Me.ComboBox1.AddItem c
   Next c
   Me.ComboBox1.ListIndex = 0
End Sub


Private Sub ComboBox1_Change()
Dim p
Dim x, y As Long
    Me.ComboBox2.Visible = True
    Set p = Sheets("Planning")
    Set mondico = CreateObject("scripting.dictionary")
    x = ActiveCell.Row() + 1
    y = ActiveCell.End(xlDown).Row - 1
        For Each c In p.Range("C" & x, "C" & y)
        mondico(c.Value) = ""
        Next c
    Me.ComboBox2.AddItem ""
        For Each c In mondico.keys
    Me.ComboBox2.AddItem c
        Next c
   Me.ComboBox2.ListIndex = -1
End Sub


Private Sub ComboBox2_Change()
  ActiveCell = Me.ComboBox1
  Unload Me
End Sub

NezQuiCoule · 5 Mars 2015

Re : Planning sur semaine glissante, ouverture USF trop longue

Bonsoir piga25,

Je viens de vérifier et tu vas être content car j'ai trouvé par hasard au premier coup d'oeil..

Remplace :

Code:

y = ActiveCell.End(xlDown).Row - 1

par

Code:

y = ActiveCell.End(xlUp).Row - 1

Avec xlDown y valait plus d'un million

Paf · 5 Mars 2015

Re : Planning sur semaine glissante, ouverture USF trop longue

Bonsoir piga25, NezQuiCoule

pas sûr que ça fasse gagner beaucoup de temps, mais plutôt que:

Code:

   For Each c In mondico.keys
     Me.ComboBox1.AddItem c
   Next c

on peut écrire

Code:

ComboBox1.List =  mondico.keys

reste à voir si c'est compatible avec le Me.ComboBox1.AddItem "" situé juste avant?

A+

piga25 · 6 Mars 2015

Re : Planning sur semaine glissante, ouverture USF trop longue

Bonjour,

Merci pour ces réponses.

Paf: Cela fonctionne mais aucun temps de gagné.
NQC: En effet le problème doit venir de là. C'est rapide et normal maintenant, sauf que j'ai la liste situé au dessus mais pas en dessous. Il faudrait la liste située en desous de la cellule active et jusqu'à la première cellule renseignée.

laetitia90 · 6 Mars 2015

Re : Planning sur semaine glissante, ouverture USF trop longue

bonjour piga nez quicoule paf

ComboBox1_click a la place de change peut etre??

laetitia90 · 6 Mars 2015

Re : Planning sur semaine glissante, ouverture USF trop longue

re

essai d'initialiser comme cela

Code:

Private Sub UserForm_Initialize()
  Dim m As Object, t(), i As Long
  Set m = CreateObject("Scripting.Dictionary")
   t = Feuil2.Range("a2:a" & Feuil2.Cells(Rows.Count, 1).End(3).Row)
   For i = 1 To UBound(t): m(t(i, 1)) = "": Next i
   ComboBox1.List = m.keys
 End Sub

apres il faut revoir code click sur combo1
mais pas le temps de regarder

NezQuiCoule · 6 Mars 2015

Re : Planning sur semaine glissante, ouverture USF trop longue

Bonjour piga, laetitia, Paf,

Si tu veux la liste des heures en dessous de la cellule active :

Code:

y = Range("C" & p.Rows.Count).End(xlUp).Row

Si... · 6 Mars 2015

Re : Planning sur semaine glissante, ouverture USF trop longue

salut

L'objet "dictionary" est utile pour avoir très rapidement des listes sans doublon. Cependant plus il y a d'items plus la durée est conséquente. C'est ce qui se passait avec ta seconde liste (mauvaise limite supérieure).
Dans ton cas, avec ce que j'ai compris, on ne dépasse pas la ligne 52.
quelques remarques :
Avec 2010, l'outil Tableau permet bien des facilités.
La référence à l'onglet d"où est lancé la macro est inutile quand on travaille sur celui-ci.
J'ai choisi, ici, d'effacer les lignes sous celle qui est sélectionnée mais on peut supprimer cette action.

piga25 · 6 Mars 2015

Re : Planning sur semaine glissante, ouverture USF trop longue

Bonjour NQC, Laetitia, Si

Voici le code que j'ai adapté pour n'avoir que le créneau horaire disponible. Il fonctionne bien sans interférer dans la durée d'exécution.

Code:

Private Sub ComboBox1_Change()
Dim p
Dim x, y, z As Long
    Me.ComboBox2.Visible = True
    Set p = Sheets("Planning")
    Set mondico = CreateObject("scripting.dictionary")
    x = ActiveCell.Row()
    z = ActiveCell.Column
    y = Cells(x, z).End(xlDown).Row - 1
        For Each c In p.Range("C" & x, "C" & y)
        mondico(c.Value) = ""
        Next c
    Me.ComboBox2.AddItem ""
        For Each c In mondico.keys
    Me.ComboBox2.AddItem c
        Next c
   Me.ComboBox2.ListIndex = -1
End Sub

Laetitia et Si, je regarde vos codes.
Si, je vais m'inspirer du tien pour mettre en couleur les cellules correspondantes au créneau horaire sélectionné.

Merci pour toutes vos infos.
reste à améliorer le fichier.

piga25 · 6 Mars 2015

Re : Planning sur semaine glissante, ouverture USF trop longue

Bonjour,

J'ai regardé les codes de SI, et cela me semble pas mal du tout.
J'ai un peu modifié ceux-ci mais rien de bien méchant (j'espère ne pas les avoir trop matraqué).
donc pour la feuille planning :

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect([D4:ABG52], Target) Is Nothing And Target.Count = 1 Then
    'ActiveCell.Resize(52 - ActiveCell.Row, 1).Interior.ColorIndex = xlNone
    'ActiveCell.Resize(52 - ActiveCell.Row, 1) = ""
    If ActiveCell <> "" Then
    MsgBox "Le véhicule est déjà réservé pour ce créneau horaire !" & vbCrLf & vbCrLf & " voulez-vous mofifier ce créneau horaire ?"
    Exit Sub
    End If
    UserForm1.Show
    Cells(1, 1).Select
  End If
End Sub

pour l'USF1 :

Code:

Dim D As Object, y As Byte
Private Sub UserForm_Initialize()
   Set D = CreateObject("Scripting.Dictionary")
   For Each c In [Tc]:   D(c.Value) = "":   Next
   ComboBox1.AddItem ""
   ComboBox1.List = D.keys
   ComboBox1.ListIndex = -1
End Sub


Private Sub ComboBox1_Change()
Dim x, y, z
  ComboBox2.Visible = True
  ComboBox2.AddItem ""
  x = ActiveCell.Row() - 1
  z = ActiveCell.Column()
  y = Cells(x, z).End(xlDown).Row - 1
  ComboBox2.List = Range("C" & x & ":C" & y).Value
  ComboBox2.ListIndex = -1
End Sub


Private Sub ComboBox2_Change()
  y = ComboBox2.ListIndex
  ActiveCell.Resize(y, 1) = ComboBox1
  ActiveCell.Resize(y, 1).Interior.ColorIndex = [Tc].Find(ComboBox1).Interior.ColorIndex
  Unload Me
End Sub

Une chose que je n'ai pas réussi à faire, c'est lorsque le premier nom dans la liste est choisi, je n'arrive pas à mettre la couleur comme aux suivants.
De même pour le message box, pas moyen de faire un choix.

Merci pour ces conseils.

Si... · 6 Mars 2015

Re : Planning sur semaine glissante, ouverture USF trop longue

re

Il faut ouvrir l'usf si... oui :

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Not Intersect([D4:ABG52], Target) Is Nothing And Target.Count = 1 Then
    If ActiveCell = "" Then Exit Sub
    If MsgBox(" voulez-vous mofifier son créneau horaire ?", 4, _
                  "Le véhicule est déjà réservé !") = 7 Then Exit Sub
    UserForm1.Show
    Cells(1, 1).Select
  End If
End Sub

piga25 · 6 Mars 2015

Re : Planning sur semaine glissante, ouverture USF trop longue

Re,

Ce n'est pas exactement cela.
Si la cellule est vide, ouvrir USF normalement et saisir les données.
Si la cellule est déjà renseignée, demander si l'on veut modifier le créneau horaire, si non sortir, si oui pouvoir modifier le créneau horaire.
Dans ce dernier cas, je pense qu'il faut avoir la liste complète des heures, du moins de la ligne active jusqu'à la ligne 52.

piga25 · 6 Mars 2015

Re : Planning sur semaine glissante, ouverture USF trop longue

Bonjour à tous,

J'avance petit à petit.
J'ai réussi avec les msgbox, mais il se peut qu'il y ai plus court pour avoir le même résultat.

- Par contre, autre problème, lorsque je veux modifier un créneau, cela m'efface le reste de la colonne.,
pas encore trouvé de piste...

- De plus il existe encore un souci avec les heures, il manque 1/2 heure et lorsque l'on saisie uniquement un créneau d'une 1/2 heure il y a une erreur.

Si... · 7 Mars 2015

Re : Planning sur semaine glissante, ouverture USF trop longue

re

avant de reprendre ton dernier fichier, une autre façon de gérer le planning (sélection en long, en large et peut-être en travers).

Planning sur semaine glissante, ouverture USF trop longue

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

Discussions similaires

Partager cette page

Statistiques des forums