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 If

PS : 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 With

Re,

@ 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 ?

132test-userform2.zip (18.23 Ko)
141horaires.zip (17.69 Ko)

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:=False

Serait-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.

14horaires-forum.zip (15.37 Ko)

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 Sub

Merci.

26horaires-forum.zip (15.38 Ko)

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 ....

Rechercher des sujets similaires à "rechercheh vba"