Autres VBA extraire donnée entre deux dates

A

akira21

XLDnaute Occasionnel
Bonjour,

J'aimerai extraire les données d'un classeur externe en choisissant la date et l'heure du début ainsi que la date et l'heure de fin.
J'ai jusqu'à maintenant réussi à récupérer les données d'une feuille à l'autre sans sélection de date.
Comment faire pour avoir une boite de dialogue (heure début / heure fin) et aller chercher les données dans un fichier externe sans l'ouvrir ?

PS : est ce que le code est optimisé ?

Merci de votre aide

VB: 
Sub Gestion_Condi()

'Récupères les infos des flux sortant packing condi

Dim j As Integer, i As Integer
Dim cel As Range
Dim n As Integer

Range(Sheets("Condi").Range("U2"), Sheets("Condi").Range("AA40")).Delete Shift:=xlUp
j = 0
For Each cel In Range(Sheets("Condi").Range("A2"), Sheets("Condi").Range("A2").End(xlDown))
'Récupère les données dans un tableau temporaire
     If cel.Offset(0, 8).Value > 1 And cel.Offset(0, 7).Value <> "" Then
'heure fin'
        Sheets("Condi").Range("U2").Offset(j, 0) = cel.Offset(0, 12)
 'Ligne'
        Sheets("Condi").Range("U2").Offset(j, 1).Value = "Condi"
'Code PF'
        Sheets("Condi").Range("U2").Offset(j, 2) = cel.Offset(0, 0)
'N° Programme'
        Sheets("Condi").Range("U2").Offset(j, 3) = cel.Offset(0, 2)
      
        

        j = j + 1
    End If
Next

'compte le nombre d'actions déjà extractés
n = 0
While Sheets("Bilan Stock").Range("B3").Offset(n, 0) <> ""
    n = n + 1
Wend
n = n + 3

'Copie le tableau temporaire dans l'onglet bilan et le supprime
Range(Sheets("Condi").Range("U2"), Sheets("Condi").Range("U2").End(xlDown).Offset(0, 5)).Copy Destination:=Sheets("Bilan Stock").Range("B" & n)

End Sub
 

Pièces jointes

  • Test.xlsm
    39.1 KB · Affichages: 23
Trier par date Trier par votes
Calvus

Calvus

XLDnaute Barbatruc
Bonjour et bienvenue sur le forum,


Voici pour choisir les dates voulues.

VB: 
Sub Gestion_Condi()

'Récupères les infos des flux sortant packing condi

Dim j As Integer, i As Integer
Dim cel As Range
Dim n As Integer
Dim Madatedeb As Date, Madatefin As Date

Madatedeb = InputBox("Date de début ?")

Madatefin = InputBox("Date de fin ?")


Range(Sheets("Condi").Range("U2"), Sheets("Condi").Range("AA40")).Delete Shift:=xlUp
j = 0
For Each cel In Range(Sheets("Condi").Range("A2"), Sheets("Condi").Range("A2").End(xlDown))
'Récupère les données dans un tableau temporaire
     If cel.Offset(0, 8).Value > 1 And cel.Offset(0, 7).Value <> "" _
     And cel.Offset(0, 11) >= Madatedeb And cel.Offset(0, 12) < Madatefin Then
'heure fin'
        Sheets("Condi").Range("U2").Offset(j, 0) = cel.Offset(0, 12)
 'Ligne'
        Sheets("Condi").Range("U2").Offset(j, 1).Value = "Condi"
'Code PF'
        Sheets("Condi").Range("U2").Offset(j, 2) = cel.Offset(0, 0)
'N° Programme'
        Sheets("Condi").Range("U2").Offset(j, 3) = cel.Offset(0, 2)
      
        

        j = j + 1
    End If
Next

'compte le nombre d'actions déjà extractés
n = 0
While Sheets("Bilan Stock").Range("B3").Offset(n, 0) <> ""
    n = n + 1
Wend
n = n + 3

'Copie le tableau temporaire dans l'onglet bilan et le supprime
Range(Sheets("Condi").Range("U2"), Sheets("Condi").Range("U" & Rows.Count).End(xlUp)).Resize(, 4).Copy Destination:=Sheets("Bilan Stock").Range("B" & n)

End Sub

A+
 
Vote positif 0 Vote négatif
A

akira21

XLDnaute Occasionnel
Bonjour Calvus,

Merci beaucoup pour ton aide, ça fonctionne :)
Par contre si je fais annuler, ça me met un message d'erreur.
Le débogage me renvoie sur cette ligne :

Madatedeb = InputBox("Date de début ?")

As tu une solution ?

Encore merci pour ton aide
 
Vote positif 0 Vote négatif
MP59

MP59

XLDnaute Occasionnel
Bonjour à tous,
Power Query permet de poser les conditions de dates.
Ici dans la requête je mets 1 pour les dates qui répondent aux conditions (barre de formule)
et je garde les lignes avec la colonne test à 1 pour fermer et charger le résultat de la requête (qui porte sur le fichier fermé condi horaire où j'ai préalablement remis les données de ta feuille condi).
1588783520090.png


1588783699845.png


1588784090716.png

je ne joins pas les fichiers car le chemin de la source de données est défini sur mon ordi.

A adapter au besoin le cas échéant.
 
Dernière édition:
Vote positif 0 Vote négatif
A

akira21

XLDnaute Occasionnel
J'ai d'autres questions !

Quel serait la méthode en VBA pour extraire les données non pas entre deux dates mais entre deux n° de programme de la colonne "C" ?

Et dans mon exemple, j'ai mis le tableau dans la feuille "Condi" mais en réalité, c'est dans un fichier externe, dans la feuille "Ordo".
Quel serait la méthode pour accéder aux infos de ce fichier sans l'ouvrir ?

Dernière chose, finalement l'idéal ne serait pas d'avoir d'inputbox mais d'écrire les deux numéros de programme dans 2 cellules de l'onglet Bilan Stock.
Comment faire ?

Je suis désolé pour toutes ses questions mais cela dépasse mes compétences :(

Merci de votre aide :)
 
Vote positif 0 Vote négatif
Calvus

Calvus

XLDnaute Barbatruc
Re,

akira21 à dit:
Quel serait la méthode pour accéder aux infos de ce fichier sans l'ouvrir ?
Cliquez pour agrandir...

Je ne suis pas vraiment familiarisé avec cette méthode mais je sais que c'est faisable.
Pourquoi tiens tu absolument à ne pas ouvrir le classeur ?

Pour le reste, voici, si j'ai bien compris ta demande.

VB: 
Sub Gestion()
Dim i%, t, f_Condi As Worksheet, f_Bilan As Worksheet

Set f_Condi = Sheets("Condi")
Set f_Bilan = Sheets("Bilan Stock")

t = f_Condi.Range("A1:M" & f_Condi.Range("A" & Rows.Count).End(3).Row)

ReDim a(1 To UBound(t), 1 To UBound(t))
n = 1
For i = 1 To UBound(t)
    If t(i, 3) = f_Bilan.Range("M1") Or t(i, 3) = f_Bilan.Range("N1") Then
        a(n, 1) = t(i, 13)
        a(n, 2) = "Condi"
        a(n, 3) = t(i, 1)
        a(n, 4) = t(i, 3)
        n = n + 1
    End If
Next i

f_Bilan.Range("B" & Rows.Count).End(3).Offset(1, 0).Resize(n, 4) = a

End Sub

A+
 

Pièces jointes

  • Test akira.xlsm
    43 KB · Affichages: 40
Dernière édition:
Vote positif 0 Vote négatif
A

akira21

XLDnaute Occasionnel
Merci Calvus pour ton aide.

C'est presque ça.
Dans ton exemple, le résultat prend que les 2 programmes indiqués en M et N. Hors il faut prendre l'ensemble des programmes entre deux, M et N compris.

Désolé de t'embêter et encore merci de ton aide :)
 
Vote positif 0 Vote négatif
Calvus

Calvus

XLDnaute Barbatruc
Re,
akira21 à dit:
il faut prendre l'ensemble des programmes entre deux, M et N compris.
Cliquez pour agrandir...

Ce n'était pas très clair ça..

Alors remplace comme ceci, même si je n'ai pas optimisé, mais plus le temps là.

VB: 
Sub Gestion()
Dim i%, t, f_Condi As Worksheet, f_Bilan As Worksheet
Dim Dern_Programme%

Set f_Condi = Sheets("Condi")
Set f_Bilan = Sheets("Bilan Stock")

t = f_Condi.Range("A1:M" & f_Condi.Range("A" & Rows.Count).End(3).Row)

For i = UBound(t) To 1 Step -1
    If t(i, 3) = f_Bilan.Range("N1") Then Dern_Programme = i: Exit For
Next i

ReDim a(1 To UBound(t), 1 To UBound(t))
n = 1
For i = 1 To Dern_Programme
    If t(i, 3) = f_Bilan.Range("M1") Then
        Do Until Dern_Programme = i
        a(n, 1) = t(i, 13)
        a(n, 2) = "Condi"
        a(n, 3) = t(i, 1)
        a(n, 4) = t(i, 3)
        n = n + 1
        i = i + 1
        Loop
    End If
Next i

f_Bilan.Range("B" & Rows.Count).End(3).Offset(1, 0).Resize(n, 4) = a

End Sub

A+
 
Vote positif 0 Vote négatif

Discussions similaires

T
  • Question
XL 2016 Optimisation d'une boucle
2 3
Réponses
30
Affichages
921
thivame
T
Z
  • Résolu(e)
Microsoft 365 Problème de combinaison entre fonctions "If Then Else" et "SelectCase"
Réponses
11
Affichages
235
Zonmé
Z
F
  • Question
XL 2019 erreur 1004
Réponses
8
Affichages
231
florian50470
F
F
  • Question
Microsoft 365 Poursuivre ou pas la macro
Réponses
2
Affichages
179
Francky79
F
VBA_dev_Anne_Marie
  • Résolu(e)
Microsoft 365 VBA : somme par colonne
Réponses
9
Affichages
221
VBA_dev_Anne_Marie
VBA_dev_Anne_Marie
E
  • Question
XL 2013 vba excel
Réponses
6
Affichages
239
sylvanu
sylvanu
U
  • Question
Autres Enregistrer sur Onglet TOTO
Réponses
2
Affichages
378
un internaute
U
M
  • Question
Microsoft 365 Question code VBA
Réponses
2
Affichages
113
Maxou69
M
Z
  • Question
XL 2021 VBA Prélèvement d'une donnée si une valeur recherchée est identique
Réponses
3
Affichages
187
ZiM
Z
A
  • Résolu(e)
XL 2016 Autofill Destination sur colonne adjacente
Réponses
3
Affichages
349
Aldonanou
A

Membres actuellement en ligne

14 membres et 240 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 198
Messages
2 086 149
Membres
103 132
dernier inscrit
hedfahmi