Dois-je faire une "Loop" en VBA ou une formule ???

[Eltech]

Bonjour,
Je suis vraiment Nouveau en VBA, pour le pas dire à ma première tentative...
Je coterais mes compétences sur Excel disons à 8/10 dans mon travail mais comparativement au Pro sur ce forum sûrement que je descend à 1-2/10.

Ma question est la suivante (Voir exemple plus bas): J'ai une série de date en colonne de A1 à A5 et une série de chiffres de B1 à B5...(qui vont ensemble)

Date Nbr de congé
2011-05-13 5
2011-05-14 2
2011-05-15 1
2011-05-18 4
2011-05-20 2

Je voudrais recréer une colonne qui me donnerais la liste des dates du 2011-05-13 au 2011-05-20 incluant les dates manquantes, et dans une autre colonne le nombre correspondant et d'y écrire "0" si la date était manquante dans la liste de départ.

J'espère que vous comprendrez ce que je veux dire...car sa me serait d'une grande utilité. Car dans la vrai vie les lignes vont jusqu'à 900 !!!!

Merci à l'avance des conseils !!!

David

 

[ROGER2327]

Re : Dois-je faire une "Loop" en VBA ou une formule ???

Re…

Excusez-moi...dernière question, Est-ce le Code "TOTO2" ou "EXTRACTION1" qui donne les colonnes C et D ?

Merci encore...

Les deux, mon colonel.
La procédure EXTRACTION1 (que vous pouvez nommer autrement si le cœur vous en dit) fournit les données nécessaires à l'exécution de l'extraction opérée par la la procédure toto2. Cette façon de faire permet d'adapter très facilement la procédure d'extraction à un autre contexte : si, par exemple, les données sont dans une feuille nommées Feuille_de_données à partir de la cellule Z5 et que vous voulez que le résultat de l'extraction soit déposé dans une feuille nommée Résultat à partir de la cellule K28, il suffira de remplacer

Set oPlg = Me.[A1]
Set dPlg = Me.[C1]​

par

Set oPlg = Sheets("Feuille_de_données").[Z5]
Set dPlg = Sheets("Résultat").[K28]​

dans EXTRACTION1, sans rien modifier à toto2.

En cas de besoin, vous pouvez avoir plusieurs procédures EXTRACTION1, EXTRACTION2, EXTRACTION3, … avec des paramètres oPlg et dPlg différents utilisant toutes la même procédure toto2.

Je joins le code avec quelques commentaires qui vous permettront, je l'espère, de mieux voir le fonctionnement.

Sub EXTRACTION1()
Dim oPlg As Range, dPlg As Range
  Set oPlg = Me.[A1] 'première cellule de la plage de données.
  Set dPlg = Me.[C1] 'première cellule de la plage de destination.
  toto2 oPlg, dPlg 'appelle la procédure d'extraction proprement dite.
  'Cette façon de faire permet d'adapter facilement le code à d'autres
  'configuration. il suffit de modifier la définition de oPlg et dPlg.
End Sub

Sub toto2(oPlg As Range, dPlg As Range)
Dim i&, d&, dMin&, dMax&, tmp&, oColl As New Scripting.Dictionary
  dMin = 2958465  '31/12/9999
  dMax = 0        '01/01/1900
'
'Recherche des dates extrêmes dMin et dMax dans la colonne commençant à la cellule oPlg
  i = 0
  Do Until IsEmpty(oPlg.Offset(i, 0))
    If IsDate(oPlg.Offset(i, 0)) Then
      tmp = oPlg.Offset(i, 0).Value
      dMin = (dMin + tmp - Math.Abs(tmp - dMin)) / 2
      dMax = (dMax + tmp + Math.Abs(tmp - dMax)) / 2
    End If
    i = i + 1
  Loop
'
'Création de la liste ordonnée oColl de toutes les dates de dMin à dMax
  For d = dMin To dMax: oColl.Add d, 0: Next
'
'Association des données de la deuxième colonne la plage associée à de oPlg aux dates
'correspondantes dans oColl
  i = 0
  Do Until IsEmpty(oPlg.Offset(i))
    If IsDate(oPlg.Offset(i)) Then oColl(CDbl(oPlg.Offset(i))) = oPlg.Offset(i, 1)
    i = i + 1
  Loop
'
'Procédure d'affichage des résultats dans la plage commençant à la cellule dPlg
  i = dPlg.Parent.Cells(dPlg.Parent.Rows.Count, dPlg.Column).End(xlUp).Row - dPlg.Row + 1
  With Application: .ScreenUpdating = 0: .Calculation = -4135: .EnableEvents = 0: End With
  dPlg.Resize(IIf(i < 1, 1, i), 2).ClearContents
  If oColl.Count Then
    With dPlg.Resize(oColl.Count)
      .NumberFormat = oPlg.NumberFormat
      .Cells = WorksheetFunction.Transpose(oColl.Keys)
    End With
    dPlg.Resize(oColl.Count).Offset(0, 1) = WorksheetFunction.Transpose(oColl.Items)
  End If
  With Application: .EnableEvents = 1: .Calculation = -4105: .ScreenUpdating = 1: End With
End Sub

​

Bon courage.

ROGER2327
#5279

Vendredi 13 Merdre 138 (Sainte Lunette, solitaire - fête Suprême Quarte)
11 Prairial An CCXIX, 8,4466h - fraise
2011-W22-1T20:16:19Z

 

[Eltech]

Re : Dois-je faire une "Loop" en VBA ou une formule ???

Merci beaucoup de ta patience ROGER2327,

Tes explications ne peuvent pas être plus claires. J'ai tenté de copié tes codes "TOTO2" et "EXTRACTION1" tel que tu l'a fait. J'ai modifié les Set oPlg et Set dplg en fonction de mes feuilles. Suite à cela, quand j'exécute le code j'obtiens un message d'erreur: Erreur de compilation ("oColl as new Scripting.Dictionary" est surligné et on mentionne: Type défini par l'utilisateur non-défini). Ça me donne le même message d'erreur si je prends ton fichier Excel (copie d'exemple) et que je mets d'autre date que ceux que tu a mis.

Parcontre pour me vérifier, j'ai seulement effacer les résultantes (colonne C et D)de ton fichier et exécuter le code, et là tout fonctionne, les colonnes C et D se remplissent comme il se doit.

Bref c'est quand je met d'autre date que les tiennent (qui sont effectivement dans ton range 9999-1900) qu'il y a un erreur


Merci Mille fois...

 

[ROGER2327]

Re : Dois-je faire une "Loop" en VBA ou une formule ???

Re…

(…) quand j'exécute le code j'obtiens un message d'erreur: Erreur de compilation ("oColl as new Scripting.Dictionary" est surligné et on mentionne: Type défini par l'utilisateur non-défini) (…)

Sur ce point, deux remèdes :

1. Dans toto2, remplacer la ligne :

   Dim i&, d&, dMin&, dMax&, tmp&, oColl As New Scripting.Dictionary

   par ces deux lignes :

   Dim i&, d&, dMin&, dMax&, tmp&, oColl As Object
     Set oColl = CreateObject("Scripting.Dictionary")

   Pourquoi ? Parce que l'objet Dictionary n'appartient ni à la bibliothèque Excel ni à la bibliothèque VBA. C'est un objet appartenant à la bibliothèque Scripting, d'où la nécrssité d'invoquer cette bibliothèque par CreateObject.
2. Ne rien changer au code, mais associer la bibliothèque Scripting à votre classeur. Pour ce faire, ouvtir l'éditeur VBA (en affichant le code toto2, par exemple). Dans le menu Outils, cliquer Références…. Dans la fenêtre qui s'ouvre, chercher et cocher Microsoft Scripting Runtime. Valider par OK et refermer l'éditeur : ça devrait rouler…

Ceci fait, on verra s'il subsiste des problèmes et, le cas échéant, on cherchera une solution.​

Bonne soirée.

ROGER2327
#5280

Samedi 14 Merdre 138 (Saint Sphincter, profès - fête Suprême Quarte)
12 Prairial An CCXIX, 6,7090h - bétoine
2011-W22-2T16:06:06Z

 

[Eltech]

Re : Dois-je faire une "Loop" en VBA ou une formule ???

ROGER 2327,

J'ai pris le remère #1 et tout fonctionne. En vous remerciant énormément. Ces dernières lignes vont clorent mes interrogations pour ce "post".
Ce site est fantastique, vous avez une patience d'or.

Merci.
David de Québec

 

[ROGER2327]

Re : Dois-je faire une "Loop" en VBA ou une formule ???

Re…

ROGER 2327,

J'ai pris le remère #1 et tout fonctionne. En vous remerciant énormément. Ces dernières lignes vont clorent mes interrogations pour ce "post".
Ce site est fantastique, vous avez une patience d'or.

Merci.
David de Québec

Parfait !

Et merci pour ce petit mot : ça fait toujours plaisir de savoir qu'on est utile.​

Bonne continuation.

ROGER2327
#5282

Samedi 14 Merdre 138 (Saint Sphincter, profès - fête Suprême Quarte)
12 Prairial An CCXIX, 6,8553h - bétoine
2011-W22-2T16:27:10Z

 

[Eltech]

Re : Dois-je faire une "Loop" en VBA ou une formule ???

TROP BEAU POUR ÊTRE VRAI !!!!

Avec votre remède #1 tout fonctionnait, dans la mesure où que je saisissait en "Col A" une dizaine de date à la main avec en "Col B" des valeurs correspondantes.

J'ai effacer ces valeurs en "Col A et B" pour y copier une liste de Date et valeur (dans les mêmes col) soit 184 lignes. J'ai copier, collage spécial/ valeur, et mis le format de date identique à celui qui fonctionnait. Quand j'exécute le code, une fenêtre de Microsoft Visual Basic s'ouvre et affiche "Incompatibilité de Type".

En bref: Date et valeur saisi à la main= OK
Copier d'un autre feuille, d'un autre fichier = Incompatibilité de type

Avez-vous une autre boué à me lancer ???

 

[ROGER2327]

Re : Dois-je faire une "Loop" en VBA ou une formule ???

Re…

TROP BEAU POUR ÊTRE VRAI !!!!
(…)

Ca commence mal !

(…)
En bref: Date et valeur saisi à la main= OK
Copier d'un autre feuille, d'un autre fichier = Incompatibilité de type

Avez-vous une autre boué à me lancer ???

Peut-être…

Avec des dates "propres" (j'entends par là des nombres entiers entre 0 et 2958465, éventuellement affiché sous forme de dates grâce à un format approprié) la procédure fonctionne.

Lors de l'importation de "dates" il se peut que vous n'ayez pas ce que j'appelle des dates propres mais des dates en format texte, par exemple. On ne voit de différence à l'affichage, si ce n'est que les dates-texte s'affichent à gauche d'une cellule à alignement standard tandis que les dates numériques s'affichent à droite.

Si le problème vient de là, le code ainsi modifié devrait fonctionner (les deux lignes modifiées sont marquées '***.)

Sub toto2(oPlg As Range, dPlg As Range)
Dim i&, d&, dMin&, dMax&, tmp&, oColl As Object 'New Scripting.Dictionary
  Set oColl = CreateObject("Scripting.Dictionary")
  dMin = 2958465  '31/12/9999
  dMax = 0        '01/01/1900
'
'Recherche des dates extrêmes dMin et dMax dans la colonne commençant à la cellule oPlg
  i = 0
  Do Until IsEmpty(oPlg.Offset(i, 0))
    If IsDate(oPlg.Offset(i, 0)) Then
      tmp = CDate(oPlg.Offset(i, 0).Value) '***
      dMin = (dMin + tmp - Math.Abs(tmp - dMin)) / 2
      dMax = (dMax + tmp + Math.Abs(tmp - dMax)) / 2
    End If
    i = i + 1
  Loop
'
'Création de la liste ordonnée oColl de toutes les dates de dMin à dMax
  For d = dMin To dMax: oColl.Add d, 0: Next
'
'Association des données de la deuxième colonne la plage associée à de oPlg aux dates
'correspondantes dans oColl
  i = 0
  Do Until IsEmpty(oPlg.Offset(i))
    If IsDate(oPlg.Offset(i)) Then oColl(CDate(oPlg.Offset(i))) = oPlg.Offset(i, 1) '***
    i = i + 1
  Loop
'
'Procédure d'affichage des résultats dans la plage commençant à la cellule dPlg
  i = dPlg.Parent.Cells(dPlg.Parent.Rows.Count, dPlg.Column).End(xlUp).Row - dPlg.Row + 1
  With Application: .ScreenUpdating = 0: .Calculation = -4135: .EnableEvents = 0: End With
  dPlg.Resize(IIf(i < 1, 1, i), 2).ClearContents
  If oColl.Count Then
    With dPlg.Resize(oColl.Count)
      .NumberFormat = oPlg.NumberFormat
      .Cells = WorksheetFunction.Transpose(oColl.Keys)
    End With
    dPlg.Resize(oColl.Count).Offset(0, 1) = WorksheetFunction.Transpose(oColl.Items)
  End If
  With Application: .EnableEvents = 1: .Calculation = -4105: .ScreenUpdating = 1: End With
End Sub

Si cela ne suffit pas, veuillez déposer un classeur avec quelques données bloquantes, car analyser des données sans les voir est difficile.​

ROGER2327
#5283

Samedi 14 Merdre 138 (Saint Sphincter, profès - fête Suprême Quarte)
12 Prairial An CCXIX, 8,4535h - bétoine
2011-W22-2T20:17:18Z

 

[Eltech]

Re : Dois-je faire une "Loop" en VBA ou une formule ???

Bonjour ROGER2327
Encore une fois très efficace vos conseils. Effectivement tout fonctionne avec vos modifications à ces 2 lignes. J'imagine et je souhaite ne plus vous embêter avec ce "post". Merci grandement encore !!!

PS: De quel coin de la planète êtes vous ? Il semble avoir un bon décallage horaire entre vous et moi, à moins que mon fuseau soit mal "Setter"

David,
Canada, Québec

 

[ROGER2327]

Re : Dois-je faire une "Loop" en VBA ou une formule ???

Re…

(…)
De quel coin de la planète êtes vous ?
(…)

Anywhere out of the world​

Mais un peu en France tout de même…​

ROGER2327
#5293

Dimanche 15 Merdre 138 (Saints Serpents d’Airain - fête Suprême Tierce)
13 Prairial An CCXIX, 7,2461h - pois
2011-W22-3T17:23:27Z