[VBA]Trouver la valeur la plus proche (Heure) [Résolu]

Messages postés
6
Date d'inscription
jeudi 31 mai 2012
Dernière intervention
29 juin 2012
- - Dernière réponse : Moun49800
Messages postés
6
Date d'inscription
jeudi 31 mai 2012
Dernière intervention
29 juin 2012
- 26 juin 2012 à 13:30
Bonjour tous le monde,

Je suis désoler de ne pas être passer par la case "Présentation", mais je suis actuellement en stage, et j'ai pas trop de temps.
Mon projet est d'automatiser l'acquisition de données de capteur pour les étalonner.
J'ai connus VBA il y a 5 semaines donc excuser moi si je fait des erreurs ou si je n’emploie pas les bon termes.

Voici le petit problème qui m’embête légèrement depuis 2 jours !!
Je vais essayer d'être clair

J'ai crée un UserForm avec un TextBox qui permet de retrouver l'heure (en format hh:mm:ss) dans la colonne B et qui sélectionne le cellule trouver.

Dim t As Range
Dim ligne  As Long
Dim col As Integer
Dim shtoto As Worksheet
Dim Lacase
   If TextBox2.Text <> "" Then                                                          'Si TextBox2 est différent de "Rien" alors
        Set t = Worksheets(1).Range("B:B").Find(TextBox2.Text, LookAt:=xlWhole)   'Chercher le texte qu'il y a d'écrit dans le TextBox2 et l'ajouter a la variable detecte
        
        'Prend la valeur de la température dans la colonne C et la mets dans le TextBox 3
        If Not t Is Nothing Then TextBox3.Text = Worksheets(1).Range("C" & (t.Row + 0)) 'Si au moins un résultat est trouver alors écrire dans la TextBox3 le contenu de la cellule de la colonne C qui a les mêmes coordonnées que "t".
                   
        If Not t Is Nothing Then TextBox4.Text = Worksheets(1).Range("D" & (t.Row + 0))
                        
        If Not t Is Nothing Then          'Si au moins un résultat est trouver alors
            ligne = t.Row                 'La variable ligne prend les coordonnées de la ligne de "t"
            col = t.Column                'La variable col prend les coordonnées de la colonne de "t"
            t.Select                      'on selectionne la cellule "t"
                           
        End If
    End If


Seulement si l'on inscrit dans TextBox2 une heure qui n'est pas contenue dans la colonne B alors il ne se passe rien.

Je voudrait donc que si l'heure inscrite dans TextBox2 n'est pas trouver, qu'il me sélectionne l'heure la plus proche.

J'espère que j'ai été clair :s

Si vous avez besoin de plus de précision ou de la totalité du code n'hésiter pas (même si sa ferait peut être peur :p)

Merci d'avance
Afficher la suite 

Votre réponse

10 réponses

Meilleure réponse
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Contributeur
Dernière intervention
11 avril 2018
3
Merci
Je t'ai fait un petit exemple de recherche du ton plus petit écart dans la colonne A :
Dim derlig As Long, trouv As Range, vu As Long, ecart As Long, i As Long
derlig = Range("A" & Rows.Count).End(xlUp).Row
ecart = 24# * 3600# 'un écart de une journée, en secondes (laisser les #)
For i = 1 To derlig
  vu = Abs(DateDiff("s", Range("A" & i).Value, CDate(TextBox1.Value)))
  Select Case vu
  Case 0
    Set trouv = Range("A" & i): Exit For
  Case Else
    If vu < ecart Then ecart vu: Set trouv Range("A" & i)
  End Select
Next
MsgBox trouv.Address


Ta colonne doit être formatée en heure
Il va de soit que tu as également intérêt à vérifier que ce que tu saisis dans la textbox est bien une heure cohérente.


________________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement vous dire ce qu'elle contient. Je n'interviendrai qu'en cas de nécessité de développ

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources a aidé 101 internautes ce mois-ci

Commenter la réponse de ucfoutu
Messages postés
14323
Date d'inscription
vendredi 14 mars 2003
Dernière intervention
15 décembre 2018
0
Merci
Bonjour,

Regardes en faisant un DateDiff avec Abs, pour tester l'heure la plus proche.

---------------------------------------------------------------------
[list=ordered][*]Pour poser correctement une question et optimiser vos chances d'obtenir des réponses, pensez à lire le règlement CS, celui-ci pour bien poser votre question ou encore celui-ci pour les PFE et autres exercices.[*]Quand vous postez un code, merci d'utiliser la coloration syntaxique (3ième icône en partant de la droite : ).[*]En VB.NET pensez à activer Option Explicit et Option Strict (propriété du projet) et à retirer l'import automatique de l'espace de nom Microsoft.VisualBasic (onglet Références dans les propriétés du projet).[*]Si votre problème est résolu (et uniquement si c'est le cas), pensez à mettre "Réponse acceptée" sur le ou les messages qui vous ont aidés/list
---
Commenter la réponse de NHenry
Messages postés
18039
Date d'inscription
lundi 7 décembre 2009
Statut
Contributeur
Dernière intervention
11 avril 2018
0
Merci
Bonjour,
1) Avant toute autre chose : je déplore que tu aies ouvert la présente discussion dans la section
Forum > VB.NET et VB 2005
qui n'a absolument rien à voir avec VBA/Excel !
Tu aurais dû l'ouvrir dans la section Langages dérivés > VBA ! Nous te serions reconnaissants de bien vouloir y prêter attention les fois prochaines.
Merci d'y veiller (et je "surveillerai).
2) ce que tu veux faire n'étant "traité" à ma connaissance par aucune formule Excel, on ne peut envisager (dommage) d'utiliser l'un des membres de WorkSheetFunction.
Reste dans ces conditions, une seule possibilité :
- parcourir en boucle toutes les cellules de la colonne de recherche
- si égalité trouvée : sortir de cette boucle avec la valeur (et la cellule) trouvées.
- tant qu'égalité non trouvée :
--- mémoriser l' "écart" si inférieur à "écart" précédemment trouvé.
--- si égalité non trouvée en fin de boucle : garder le dernier écart mémorisé.

Voilà donc le mécanisme. A toi de le mettre en oeuvre, maintenant.
Je ne t'aiderai qu'au vu du code que tu auras bien voulu tenter d'écrire sur ces bases (au demeurant simples).


________________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches.
Pas d'aide en ligne installée ? => ne comptez pas sur moi pour simplement vous dire ce qu'elle contient. Je n'interviendrai qu'en cas de nécessité de développ
Commenter la réponse de ucfoutu
Messages postés
1403
Date d'inscription
mardi 1 mai 2007
Dernière intervention
7 octobre 2012
0
Merci
Bonjour,
Je voudrait donc que si l'heure inscrite dans TextBox2 n'est pas trouver, qu'il me sélectionne l'heure la plus proche.


Alors oublies le "Find", et optes pour une boucle.

-Initialise une variable "ValRet" avec la valeur de la première cellule.
-Parcours ta colonne B.

-Si (valeur cellule = valeur TextBox) Alors
ValRet=valeur cellule
==> SORTIR

-Sinon Si (valeur cellule > ValRet) Et (valeur cellule < valeur TextBox) Alors
ValRet=valeur cellule
==>POURSUIVRE





[] Ce qui va sans dire. va mieux en le disant.
Commenter la réponse de LIBRE_MAX
Messages postés
1403
Date d'inscription
mardi 1 mai 2007
Dernière intervention
7 octobre 2012
0
Merci
Bonjour Jacques,

Même idée alors..
En retard, une fois de plus !

[] Ce qui va sans dire. va mieux en le disant.
Commenter la réponse de LIBRE_MAX
Messages postés
6
Date d'inscription
jeudi 31 mai 2012
Dernière intervention
29 juin 2012
0
Merci
Désoler ucfoutu pour le post mis dans la mauvaise rubrique je ferait attention la prochaine fois.

Merci pour vos réponse, je test sa et je vous dit s'y je résous mon problème.
Commenter la réponse de Moun49800
Messages postés
6
Date d'inscription
jeudi 31 mai 2012
Dernière intervention
29 juin 2012
0
Merci
Bon voilà je doit vraiment être un chèvre...
J'ai essayer d'appliquer ce que vous m avez répondu, cependant je ne doit même pas savoir comment parcourir ma colonne vue l'erreur que VB me mets.
Voilà ce que j ai écris (j'ai une erreur avec le Next, qui doit être une erreur de gros gros débutant désoler ):

    If TextBox2.Text <> "" Then                                                          'Si TextBox2 est différent de "Rien" alors
        'Set Lacase = Worksheets(2).Range("B:B").Find(TextBox2.Text, LookIn:=xlValues)   'Chercher le texte qu'il y a d'écrit dans le TextBox2 et l'ajouter a la variable detecte
        ValRet = Cells(2, 2).Value
        For i = 2 To 4000
        
        If Cells(i, 2).Value = TextBox2.Value Then
            ValRet = Cells(i, 2)
            Exit For
        
        Else
            If (Cells(i, 2).Value > ValRet) And (Cells(i, 2).Value < TextBox2.Value) Then
                ValRet = Cells(i, 2).Value
            End If
        End If
        
        Next i
 
         
        
        'Prend la valeur de la température dans la colonne C et la mets dans le TextBox 3
        If Not Lacase Is Nothing Then TextBox7.Text = Worksheets(2).Range("C" & (Lacase.Row + 0)) 'Si au moins un résultat est trouver alors écrire dans la TextBox3 la cellule de la colonne C qui a les mêmes coordonnées que "detecte".
                   
        If Not Lacase Is Nothing Then TextBox8.Text = Worksheets(2).Range("D" & (Lacase.Row + 0))
                        
        If Not Lacase Is Nothing Then          'Si au moins un résultat est trouver alors
            ligne = Lacase.Row                 'La variable ligne prend les coordonnées de la ligne de "detecte"
            col = Lacase.Column                'La variable col prend les coordonnées de la colonne de "detecte"
            Lacase.Select                      'on selectionne la cellule "detecte"
                           
        End If
    End If
Commenter la réponse de Moun49800
Messages postés
1403
Date d'inscription
mardi 1 mai 2007
Dernière intervention
7 octobre 2012
0
Merci
Tu oublies juste de nous communiquer le contenu du message d' erreur.

En attendant, quelques remarques cependant:
-Initialises ValRet à 0, plutôt que par la valeur de la première cellule.
Sinon tu risques d' avoir des surprises.

-En relisant le post de ucfoutu, je me rend compte que
la recherche du plus petit écart, est la méthode la plus appropriée.
Parce que quelle valeur est la plus proche de 04:10:45 ?
Est-ce 03:51:40 OU 04:14:05 ?






[] Ce qui va sans dire. va mieux en le disant.
Commenter la réponse de LIBRE_MAX
Messages postés
6
Date d'inscription
jeudi 31 mai 2012
Dernière intervention
29 juin 2012
0
Merci
Merci Beaucoup pour vos réponses sincèrement.

Mais avec mon tuteur on n'a trouver une solution qui est vraiment moche a vos yeux je pense (insertion d'une formule INDEX )mais elle remplie mets attentes

Je post le code pour ceux, à qui se seraient utiles :

Private Sub ComboBox2_Change()

Dim NbrCases
Dim lig_fin


                        If ComboBox2.Text "3sec> 10min" Then    'Si la selection de la ComboBox est égale à "3sec => 10min" alors
                            NbrCases 200                          'NbrCases200
                        End If                                      'Fin si
                        If ComboBox2.Text "3sec> 30min" Then
                            NbrCases = 600
                        End If
         
                        If ComboBox2.Text "10sec> 10min" Then
                            NbrCases = 60
                        End If
                        If ComboBox2.Text "10sec> 30min" Then
                            NbrCases = 180
                        End If
                        
Sheets(1).Select
Dim t As Range
Dim ligne  As Long
Dim col As Integer
Dim shtoto As Worksheet
Dim Lacase
Dim ValRet
Dim ValeurApproch

Sheets(2).Select
    If TextBox2.Text <> "" Then                                                          'Si TextBox2 est différent de "Rien" alors
        Set Lacase = Worksheets(2).Range("B:B").Find(TextBox2.Text, LookIn:=xlValues)   'Chercher le texte qu'il y a d'écrit dans le TextBox2 et l'ajouter a la variable detecte
        
        'Prend la valeur de la température dans la colonne C et la mets dans le TextBox 3
        If Not Lacase Is Nothing Then TextBox7.Text = Worksheets(2).Range("C" & (Lacase.Row + 0)) 'Si au moins un résultat est trouver alors écrire dans la TextBox3 la cellule de la colonne C qui a les mêmes coordonnées que "detecte".
                   
        If Not Lacase Is Nothing Then TextBox8.Text = Worksheets(2).Range("D" & (Lacase.Row + 0))
                        
        If Not Lacase Is Nothing Then          'Si au moins un résultat est trouver alors
            ligne = Lacase.Row                 'La variable ligne prend les coordonnées de la ligne de "detecte"
            col = Lacase.Column                'La variable col prend les coordonnées de la colonne de "detecte"
            Lacase.Select                      'on selectionne la cellule "detecte"
                           
        End If
    End If
               
            Range(ActiveCell, ActiveCell(NbrCases, 3)).Copy     'copie des NbrCases (= valeur de 60 à 600 ) lignes en dessous de la cellule "detecte" (qui est active)
            Sheets(5).Select                                    'Selection de la feuille 5
    
                 Range("D4").Select                             'selection de "A4"
                 ActiveSheet.Paste                              '"Coller" la selection
                 Application.CutCopyMode = False                'Enlever la surbrillance de la selection


    Sheets(2).Select
    Range("H3").FormulaR1C1 = TextBox2.Text
    Range("H13").FormulaR1C1 = _
        "=INDEX('Capteur à étalonner'!C[-6],MATCH('Capteur Temp Ref'!R[-10]C,'Capteur à étalonner'!C[-6],1))"       '=INDEX('Capteur à étalonner'!B:B,EQUIV('Capteur Temp Ref'!H3,'Capteur à étalonner'!B:B,1))
    
    Range("H13").Select
    Selection.NumberFormat = "h:mm:ss"
    ValeurApproch = Range("H13").Value
    Sheets(1).Select
    Range("H8").Value = ValeurApproch
    Range("H8").Select
    Selection.NumberFormat = "h:mm:ss"


   If TextBox2.Text <> "" Then                                                          'Si TextBox2 est différent de "Rien" alors
   
   
        Set t = Worksheets(1).Range("B:B").Find(Range("H8").Text, LookAt:=xlWhole)   'Chercher le texte qu'il y a d'écrit dans le TextBox2 et l'ajouter a la variable t
             
        'Prend la valeur de la température dans la colonne C et la mets dans le TextBox 3
        If Not t Is Nothing Then TextBox3.Text = Worksheets(1).Range("C" & (t.Row + 0)) 'Si au moins un résultat est trouver alors écrire dans la TextBox3 la cellule de la colonne C qui a les mêmes coordonnées que "t".
                   
        If Not t Is Nothing Then TextBox4.Text = Worksheets(1).Range("D" & (t.Row + 0))
                        
        If Not t Is Nothing Then          'Si au moins un résultat est trouver alors
            ligne = t.Row                 'La variable ligne prend les coordonnées de la ligne de "t"
            col = t.Column                'La variable col prend les coordonnées de la colonne de "t"
            t.Select                      'on selectionne la cellule "t"
                           
        End If
          
    End If
          
            Range(ActiveCell, ActiveCell(NbrCases, 3)).Copy     'copie des NbrCases (= valeur de 60 à 600 ) lignes en dessous de la cellule "detecte" (qui est active)
            Sheets(5).Select                                    'Selection de la feuille 5
    
                 Range("A4").Select                             'selection de "A4"
                 ActiveSheet.Paste                              '"Coller" la selection
                 Application.CutCopyMode = False                'Enlever la surbrillance de la selection
             
End Sub



Excusez moi pour le dérangement qui n'aurait pas dû avoir lieu mais je m'arrachais les cheveux, c'est pourquoi j'ai solliciter votre aide.

Merci encore
Commenter la réponse de Moun49800
Messages postés
6
Date d'inscription
jeudi 31 mai 2012
Dernière intervention
29 juin 2012
0
Merci
Merci ucfoutu. J'ai un peut modifier mais sa marche

Merci tous le monde.
Commenter la réponse de Moun49800

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.