RechercheH dans VBA
Bonjour le Forum,
Débutant en VBA, je bloque sur une petite chose.
Voilà, je cherche à insérer une rechercheh dans une macro et de récupérer la colonne jusqu'à la dernière cellule non vide. (pfiou).
Voici la partie du code associé :
If CbxSens = "Aller" And Cbx.Periode = "Verte" Then
Workbooks.Open Filename:="C:\Documents and Settings\stagiaire\Bureau\Horaires.xls"
Sheets("L111_1V").Select
End IfPS : la recherche porte sur TtBxHeure.Value. => rechercheh(TtBx.Value;A1:AM60;1).
Je vois vraiment pas comment l'insérer.
Je vous remercie d'avance.
Bonjour
En espérant de ne pas m'être planté
Sans test car pas de fichier
With Sheets("celle_que_tu_veux")
resultat = WorksheetFunction.HLookup(TtBx.Value, .Range("A1:AM" & .Range("A" & Rows.Count).End(xlUp).Row), Ligne_Recherche, False)
End WithRe,
@ Banzai64 : Merci de ta réponse.
Je joins le fichier mais il y a plein de choses en cours.
En gros, j'ai un userform pour récupérer les horaires, noms des arrêts et distances sur des lignes d'autocars dans deux fichiers séparés.
Et je me heurte à un problème de condition suivant les jours, les périodes etc ...
Je vais être blindé de If et Select .... Bref.
Question : Comment je colle ta variable resultat dans mon fichier userform et dans une colonne et une ligne précise ?
Bonjour
Ne connaissant pas tous les tenants et aboutissants
A voir
Re,
Merci, on se rapproche de ce que je souhaite mais au lieu de la listbox, je voudrais l'affichage dans le fichier à la colonne D3.
Après le souci, c'est de trier les horaires selon le jour, la période et le sens.
C'est possible mais avec vraiment beaucoup de if.
Bonjour
A voir
Maxi a écrit :Après le souci, c'est de trier les horaires selon le jour, la période et le sens.
Pour savoir de quoi tu causes, fais un exemple de résultat
Re,
Merci à toi.
Par contre, je veux chercher les horaires selon l'heure de début, c'est à dire la ligne 1 du fichier Horaires.xls.
Il me semble que ce n'est pas le cas.
Un exemple de résultat hum
Ligne 111 => Dimanche - Fêtes => Aller => V
J'ai le 09:40 ; le 14:50 et le 18:00 ( trois dernières plages feuille L111_1V de Horaires.xls)
Il faudrait donc trier sur la ligne, le jour, le sens et la période. Et je vois pas trop comment, sans faire intervenir une centaine de If sur les 5 lignes d'autocars
Bonjour
Maxi a écrit :Ligne 111 => Dimanche - Fêtes => Aller => V
Comment à partir de ces renseignements tu arrives à
Maxi a écrit :J'ai le 09:40 ; le 14:50 et le 18:00 ( trois dernières plages feuille L111_1V de Horaires.xls)
Bonjour,
Bah, je le sais.
Justement, je cherche à le faire automatiquement.
EDIT: je ne comprends pas trop ton code.
Set Ws = ActiveSheet
Feuille = Me.CbxLigne & "_" & Me.CbxJour.ListIndex + 1 & Me.CbxPeriode
Set WBHoraire = Workbooks.Open(ThisWorkbook.Path & "\Horaires.xls")
'Set WBHoraire = Workbooks("Horaires.xls")
Colonne = Application.Match(CSng(CDate(Me.TtBxHeure.Value)), WBHoraire.Sheets(Feuille).Rows(1), 1)
Ws.Range("D3:D" & Ws.Range("D" & Rows.Count).End(xlUp).Row).ClearContents
With WBHoraire.Sheets(Feuille)
NbLigne = .Cells(Rows.Count, Colonne).End(xlUp).Row
.Range(.Cells(1, Colonne), .Cells(NbLigne, Colonne)).Copy Ws.Range("D3")
End With
WBHoraire.Close savechanges:=FalseSerait-il possible de trier selon les entêtes ?, c'est à dire la ligne 1 du fichier Horaires.xls.
Actuellement, ton code trouve l'horaire et affiche quelque soit la place de l'heure (entrée par l'utilisateur dans la TextBox.) dans l'horaire de la ligne.
Merci.
Bonjour
Je ne sais pas quoi penser
Maxi a écrit :Par contre, je veux chercher les horaires selon l'heure de début, c'est à dire la ligne 1 du fichier Horaires.xls.
Il me semble que ce n'est pas le cas.
Banzai64 a écrit :Comment à partir de ces renseignements tu arrives à
Maxi a écrit :Bah, je le sais.
Si tu gardes tes renseignements pour toi, je ne peux pas continuer
Bonne journée
Bonjour,
En fait, dans le Userform, j'ai le label Heure de début avec la la TextBox TtBxHeure.
Donc, je souhaiterai chercher dans mon fichier horaire cette heure de début (c'est donc un entête pour moi.).
Actuellement, le code que tu as fait , cherche l'heure et l'affiche la plage horaire mais l'heure n'est pas forcément en première position.
Ex : TtBxHeure.Value= "12:30" le lundi, si aucunes plages ne commence à 12:30 => message d'erreur
J'ai fait le cas de la ligne 111 selon ton code (ListIndex pour les Jours).
Syntaxe feuille : Ligne_IndexJourPériodeSens
Je joins les deux fichiers. (Période Verte, Aller, Lundi-Dimanche,Ligne 111)
EDIT: Je demande juste d'aller chercher l'heure de la TextBox dans le fichier Horaires.xls comme 1ere heure donc 1ere ligne. Actuellement, le code ne fonctionne pas.
Merci.
Bonjour,
Je me permets de relancer le sujet car je rencontre des problème que je n'arrive pas à résoudre.
La macro donnée par Banzai64 cherche bien dans la première ligne des colonnes du fichier horaires mais il y a certains bugs.
Exemple : Ligne 111 => Aller => Période V => Jours de Semaine
Le 17:20 n'existe pas comme heure de début. Néanmoins, la macro le trouve et me colle le 17:05 (qui contient 17:20 comme valeur dans sa colonne).
Help.
Je joins le fichier de la ligne 111 et le fichier code (je le zipperai ce soir).
Option Explicit 'Forçer déclaration variable
Private PlageDist, PlageNom As Variant
Private Sub ButtRecherche_Click()
'Dim ligne As String
Dim WBHoraire As Workbook
Dim Ws As Worksheet
Dim Feuille As String
Dim Colonne As Integer
Dim J As Long
Dim NbLigne As Long
Dim PctDone As Single
'=================================================================
' VÉRIFICATION DES VALEURS SAISIES
'=================================================================
PctDone = 0.1
UpdateProgressBar PctDone
Set Ws = ActiveSheet
Ws.Range("A3:I65536").ClearContents
If Me.TtBxHeure.Text = "" Then
MsgBox "Vous devez entrer une heure de début !"
Me.TtBxHeure.SetFocus
Exit Sub
End If
If Not IsDate(Me.TtBxHeure) Then
MsgBox "Veuillez entrer une heure valable"
Me.TtBxHeure.SetFocus
Exit Sub
End If
'CDate convertit valeur en date.
If CDate(Me.TtBxHeure) < CDate("06:20") Or CDate(Me.TtBxHeure.Value) > CDate("19:30") Then
MsgBox "L'heure doit être comprise entre 06:20 et 19:30"
Me.TtBxHeure.SetFocus
Exit Sub
End If
If Me.CbxJour = "" Then
MsgBox "Veuillez spécifier un jour !"
Me.CbxJour.SetFocus
Exit Sub
End If
'Bloque Mise à jour Écran
Application.ScreenUpdating = False
PctDone = 0.25
UpdateProgressBar PctDone
'======================================================================
' CAS LIGNE 111
'======================================================================
'-------------------------------
'Cas Aller - Période Verte
'-------------------------------
PctDone = 0.5
UpdateProgressBar PctDone
If Me.CbxLigne.Value = "L111" And Me.CbxPeriode.Value = "V" Then
If Me.CbxJour.Value = "Mercredi" And Me.TtBxHeure.Value = "12:00" Then
PlageNom = "J3:J43"
PlageDist = "K3:K43"
Call RecupDistancesNoms
ElseIf (Me.CbxJour.Value = "Lundi" Or Me.CbxJour.Value = "Mardi" Or Me.CbxJour.Value = "Mercredi" Or Me.CbxJour.Value = "Jeudi" Or Me.CbxJour.Value = "Vendredi") And (Me.TtBxHeure.Value = "17:05" Or Me.TtBxHeure.Value = "18:20") Then
PlageNom = "D3:D44"
PlageDist = "E3:E44"
Call RecupDistancesNoms
Else
PlageNom = "A3:A36"
PlageDist = "B3:B36"
Call RecupDistancesNoms
End If
'-------------------------------
'Cas Aller - Orange
'-------------------------------
ElseIf Me.CbxPeriode = "O" Then
PlageNom = "A3:A36"
PlageDist = "B3:B36"
Call RecupDistancesNoms
'---------------------------------
'Cas Retour - Période Verte
'---------------------------------
ElseIf Me.CbxSens = "Retour" And Me.CbxPeriode = "Verte" Then
If (Me.CbxJour.Value = "Lundi" Or Me.CbxJour.Value = "Mardi" Or Me.CbxJour.Value = "Mercredi" Or Me.CbxJour.Value = "Jeudi" Or Me.CbxJour.Value = "Vendredi") And (Me.TtBxHeure.Value = "06:30") Then
PlageNom = "H3:H44"
PlageDist = "I3:I44"
Call RecupDistancesNoms
Else
PlageNom = "F3:F36"
PlageDist = "G3:G36"
Call RecupDistancesNoms
End If
'---------------------------------
'Cas Retour - Période Orange
'---------------------------------
ElseIf Me.CbxPeriode.Value = "O" Then
PlageNom = "F3:F36"
PlageDist = "G3:G36"
Call RecupDistancesNoms
End If
'*******************************************************************
'*******************************************************************
'RECHERCHE DES HORAIRES
'*******************************************************************
'*******************************************************************
PctDone = 0.75
UpdateProgressBar PctDone
'Si Erreur, voir Erreur plus loin
On Error GoTo Erreur
Set Ws = ActiveSheet
'Nom feuille avec Syntaxe particulière.
Feuille = Me.CbxLigne & "_" & Me.CbxJour.ListIndex + 1 & Me.CbxPeriode & Me.CbxSens.ListIndex + 1
'Set WBHoraire = Workbooks.Open(ThisWorkbook.Path & "\Horaires_Forum.xls")
'Ouverture du fichier Horaires
Set WBHoraire = Workbooks.Open(ThisWorkbook.Path & "\Horaires.xls")
Colonne = Application.Match(CSng(CDate(Me.TtBxHeure.Value)), WBHoraire.Sheets(Feuille).Rows(1), 1)
Ws.Range("D3:D" & Ws.Range("D" & Rows.Count).End(xlUp).Row).ClearContents
With WBHoraire.Sheets(Feuille)
NbLigne = .Cells(Rows.Count, Colonne).End(xlUp).Row
.Range(.Cells(1, Colonne), .Cells(NbLigne, Colonne)).Copy Ws.Range("D3")
End With
WBHoraire.Close savechanges:=False
PctDone = 1
UpdateProgressBar PctDone
Unload Me
'En cas Erreur, on vient ici :
'*****'
Erreur:
'Fermeture du Fichier
'Windows("Horaires.xls").Close
'Message d'erreur utilisateur
MsgBox ("Une erreur a été détecté. La course du " & Me.CbxJour.Value & " à " & Me.TtBxHeure.Value & " semble ne pas exister. Veuillez relancer une recherche svp.")
'On décharge le Userform
Unload Me
'*****'
End Sub
Sub RecupDistancesNoms()
'Récupération des Noms des Arrêts
Workbooks.Open Filename:="C:\Documents and Settings\stagiaire\Bureau\Distance.xls"
Sheets(Me.CbxLigne.Value).Select
Range(PlageNom).Select
Selection.Copy
Windows("Recherche_Horaire.xls").Activate
Sheets("codes").Select
Range("A3").Select
ActiveSheet.Paste
'Récupération Distances entre Arrêts
Windows("Distance.xls").Activate
Sheets(Me.CbxLigne.Value).Select
Range(PlageDist).Select
Selection.Copy
Windows("Recherche_Horaire.xls").Activate
Sheets("codes").Select
Range("F3").Select
ActiveSheet.Paste
Windows("Distance.xls").Close
End Sub
Sub UpdateProgressBar(PctDone As Single)
With UsfTriDonnees
' Update the Caption property of the Frame control.
.FrameProgress.Caption = Format(PctDone, "0%")
' Widen the Label control.
.LabelProgress.Width = PctDone * _
(.FrameProgress.Width - 10)
End With
' The DoEvents allows the UserForm to update.
DoEvents
End SubMerci.
Bonjour
Maxi a écrit :La macro donnée par Banzai64 cherche bien dans la première ligne des colonnes du fichier horaires mais il y a certains bugs.
Tu appelles un bug un fonctionnement normal
En te penchant un peu sur le code tu aurais remarqué que la recherche se fait avecApplication.Match (fonction EQUIV d'excel) avec comme paramètre de type 1
Si Type = 1 on retourne la valeur inférieure (Tableau triée)
Si Type = -1 on retourne la valeur supérieure (Tableau triée)
Si Type = 0 on retourne la valeur exacte, sinon valeur d'erreur (#N/A)
Bonne journée
Bonjour,
J'ai étudié ton code.
Néanmoins, j'ai trouvé des informations sur Application pas sur Application.Match.
Bref, comme je le dis dans le début de mon post, je débute en VBA.
J'ai des notions de progra mais le langage VBA m'était inconnu il y a peu.
Je suis loin d'être aussi expérimenté que toi, principe du fofo ...
Merci de ta réponse.
J'ai changé le paramètre en zéro.
Les tests semblent fonctionner.
EDIT : Ils senblaient fonctionner.
J'ai mis ceci
Colonne = Application.Match(CSng(CDate(Me.TtBxHeure.Value)), WBHoraire.Sheets(Feuille).Rows(1), 0)Maintenant, je ne récupére plus les horaires de certains jours sur certaines lignes. Les valeurs saisies sont pourtant exactes. Tout rentre dans mon On Erreur GoTo Erreur , ce qui n'était pas le cas précedemment.
Mon fichier horaires est pourtant complet.
Je ne comprends pas tout là. Avec 1 en paramètre, certaines horaires ne fonctionnaient pas et j'avais des soucis avec les distances/noms arrêts.
Avec 0, les noms arrêts/distances c'est ok mais bug avec les horaires.
Youpi
Je vais pas y arriver ....