une boucle qui semble mal fonctionner

A

alain90

XLDnaute Junior
Bonjour le forum
Bonjour à tous,

Avec l'aide de Gareth (encore merci) j'ai arrangé une macro qui recherche ( ici les RJ) à partir d'un mois et d'une année, sélectionnée dans un userform, activé (feuille "sommaire") par le bouton "lister les RJ d'un mois", dans une liste (feuille "Liste")
Mon problème est que la boucle sur les dates fonctionne mal, elle semble s’arrêter lorsqu'elle a trouvé une date et n'affiche (feuille "recherches") que cette donnée

Je n'arrive pas à envoyer le fichier même zippé (il me répond fichier non valide)
Aussi je vous joint le texte de la macro en vous signalant, si cela est important, que dans la colonne J j'ai de nombreuses plages vides comme la colonne A; la seule colonne toujours remplie est la colonne B

Private Sub CommandButton1_Click()
'valider
Application.ScreenUpdating = False 'Fige l'ecran
Sheets("Recherches").Range("A6:AF60000").Clear 'Efface les données précédentes
Set Dest = Sheets("Recherches").Range("A6") 'Définit la destination
'Date de debut et date de Fin (mois à extraire)
DateDeb = DateSerial(ComboBox2.Value, ComboBox1.Value, 1)
'Date de debut et date de Fin (mois à extraire)
DateFin = DateSerial(ComboBox2.Value, ComboBox1.Value + 1, 1)
For Each x In Sheets("Liste").Range("J6:J" & Sheets("Liste").Range("A60000").End(xlUp).Row) 'Boucle sur les dates
If x.Value >= DateDeb And x.Value < DateFin Then 'Si la date correspond au mois recherché
x.Offset(0, -9).Resize(1, 32).Copy Dest
Set Dest = Sheets("Recherches").Range("A60000").End(xlUp).Offset(1, 0) 'Définit la nouvelle destination
End If
Next
Unload Me
Application.ScreenUpdating = True
Sheets("Recherches").Select

End Sub

Pouvez-vous m'aider, moi je ne trouve pas ?

Merci d'avance pour votre réponse

Alain
 
Trier par date Trier par votes
G

GI_GI

XLDnaute Occasionnel
Re : une boucle qui semble mal fonctionner

Bonjour
Peut etre comme ça

Private Sub CommandButton1_Click()
'valider
Application.ScreenUpdating = False 'Fige l'ecran
Sheets("Recherches").Range("A6:AF60000").Clear 'Efface les données précédentes
Set Dest = Sheets("Recherches").Range("A6") 'Définit la destination
'Date de debut et date de Fin (mois à extraire)
DateDeb = DateSerial(ComboBox2.Value, ComboBox1.Value, 1)
'Date de debut et date de Fin (mois à extraire)
DateFin = DateSerial(ComboBox2.Value, ComboBox1.Value + 1, 1)
For Each x In Sheets("Liste").Range("J6:J" & Sheets("Liste").Range("B60000").End(xlUp).Row) 'Boucle sur les dates
If x.Value >= DateDeb And x.Value < DateFin Then 'Si la date correspond au mois recherché
x.Offset(0, -9).Resize(1, 32).Copy Dest
Set Dest = Sheets("Recherches").Range("A60000").End(xlUp).Off set(1, 0) 'Définit la nouvelle destination
End If
Next
Unload Me
Application.ScreenUpdating = True
Sheets("Recherches").Select

End Sub

A+
 
Vote positif 0 Vote négatif
A

alain90

XLDnaute Junior
Re : une boucle qui semble mal fonctionner

Bonjour le forum, GI_GI

déjà merci pour ta réponse
En fait vous avez juste changé la recherche à partir de la colonne a sur la col b
J'avais déjà essayé et ça ne marche pas mieux
D'autres solutions ?
merci d'avance
Alain
 
Vote positif 0 Vote négatif
A

alain90

XLDnaute Junior
Re : une boucle qui semble mal fonctionner

Bonjour le forum

J'ai enfin réussi à faire un fichier exemple
Vous verrez une feuille(feuil2) où il se trouve un bouton " RJ .."
En cliquant sur ce bouton apparait un userform où vous choisissez le mois et l'année
Lorsque vous cliquez sur "valider" alors s'effectue la recherche et c'est là qu'est mon problème :
- la boucle semble s’arrêter et retranscrire sur des valeurs mais pas toutes !!!!
Pourquoi ... je cherche mais ne trouve pas
Une aide est-elle possible ?
merci d'avance pour vos réponses

Alain
 

Pièces jointes

  • ex recherche sur date.zip
    123.4 KB · Affichages: 30
  • ex recherche sur date.zip
    123.4 KB · Affichages: 38
  • ex recherche sur date.zip
    123.4 KB · Affichages: 38
Vote positif 0 Vote négatif
sixair

sixair

XLDnaute Junior
Re : une boucle qui semble mal fonctionner

Bonjour Alain90,

il semble que la boucle fonctionne bien, mais que tu colles toujours les données sur la même ligne
la cause:
Set Dest = Sheets("Feuil2").Range("A60000").End(xlUp).Offset(1, 0) 'Définit la nouvelle destination
Cliquez pour agrandir...

En testant avec une variable de ligne, cela parait correct, il y a plein de méthodes discutables...
en voici un exemple, qui au moin montre que ça peut fonctionner:

Code: 
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False 'Fige l'ecran
Sheets("Feuil2").Range("A9:AF60000").Clear 'Efface les données précédentes
 ligne = 9 '#####MODIF#####
Set Dest = Sheets("Feuil2").Range("A" & ligne) '#####MODIF#####
DateDeb = DateSerial(ComboBox2.Value, ComboBox1.Value, 1) 'Date de debut et date de Fin (mois à extraire)
DateFin = DateSerial(ComboBox2.Value, ComboBox1.Value + 1, 1) 'Date de debut et date de Fin (mois à extraire)
For Each X In Sheets("Liste").Range("J6:J" & Sheets("Liste").Range("A60000").End(xlUp).Row) 'Boucle sur les dates
    If X.Value >= DateDeb And X.Value < DateFin Then 'Si la date correspond au mois recherché
        X.Offset(0, -9).Resize(1, 32).Copy Dest
        ligne = ligne + 1  '#####MODIF#####
        Set Dest = Sheets("Feuil2").Range("A" & ligne)  '#####MODIF#####
    End If
Next
Unload Me
Application.ScreenUpdating = False
    Sheets("Feuil2").Select
End Sub

Cordialement
 
Vote positif 0 Vote négatif
A

alain90

XLDnaute Junior
Re : une boucle qui semble mal fonctionner

bonsoir le forum
bonsoir sixair,
un grand merci pour ta réponse
Mais voilà , sur la base réelle ça marche mais il y a des oublis (exemple : je cherche les RJ de janvier 2013 - de visu j'en ai deux - et il n'en sort qu'une)
Je joins le fichier modifier pour respecter la confidentialité avec la macro modifiée comme vous me l'avez indiquée

Je n'y comprend plus rien et j'ai vraiment besoin d'aide - peut-être que la macro n'est pas bonne pour mon fichier ....

Enfin .... merci d'avance pour vos réponses fortement souhaitées

Alain
 

Pièces jointes

  • ex recherche sur date.zip
    139.2 KB · Affichages: 36
  • ex recherche sur date.zip
    139.2 KB · Affichages: 29
  • ex recherche sur date.zip
    139.2 KB · Affichages: 39
Vote positif 0 Vote négatif
A

alain90

XLDnaute Junior
Re : une boucle qui semble mal fonctionner

Bonjour le forum

Toujours pas de réponse ? aurai-je été oublié ou ne trouvez-vous pas de solution
Je suis actuellement bloqué sur ce problème .. et je cherche toujours ....mais moi, avec mes faibles connaissances....

De l'aide, s'il vous plait

Avec mes excuses pour cette insistance

merci
 
Vote positif 0 Vote négatif
A

alain90

XLDnaute Junior
Re : une boucle qui semble mal fonctionner

Bonsoir le forum
bonsoir Si et GI_GI

je viens d'essayer vos deux fichiers et ça marche
Je vous dis un grand merci pour le souci que vous venez de m’ôter
Encore merci
et merci au forum qui est super
Je considère donc le problème comme résolu
Cordialement

Alain
 
Vote positif 0 Vote négatif

Discussions similaires

L
  • Question
VBA : erreur sur boucle
Réponses
2
Affichages
106
Latias
L
T
  • Question
XL 2016 Optimisation d'une boucle
2 3
Réponses
30
Affichages
1 K
thivame
T
B
  • Résolu(e)
Microsoft 365 Besoin d'aide pour faire fonctionner 2 codes VBA ensemble
Réponses
2
Affichages
169
BenExcel
B
F
  • Question
XL 2019 erreur 1004
Réponses
8
Affichages
268
florian50470
F
R
  • Résolu(e)
XL 2019 amélioration d'une macro (actualisation auto et automatisation)
Réponses
11
Affichages
362
rh.finances
R
E
  • Résolu(e)
Microsoft 365 Boucle sur lignes <>0
Réponses
2
Affichages
176
eric72
E
M
  • Question
XL 2010 Calcul possible dans la zone de liste pour le débit et le crédit lors d'une recherche basée sur la zone de texte
Réponses
0
Affichages
449
Mody200
M
V
  • Résolu(e)
XL 2016 Facturier : Retour à la ligne sur la facture
2
Réponses
19
Affichages
641
Vermithor
V
E
  • Résolu(e)
Microsoft 365 Ajout et Suppression Date automatique
Réponses
9
Affichages
236
eric72
E
E
  • Résolu(e)
XL 2019 inserer une valeur textbox dans la dernière cellule vide horizontalement
Réponses
7
Affichages
354
escudo
E

Membres actuellement en ligne

11 membres et 117 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 490
Messages
2 088 881
Membres
103 981
dernier inscrit
vinsalcatraz