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

Question

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

Signaler

Moun49800

Messages postés: 6
Date d'inscription: jeudi 31 mai 2012
Statut: Membre
Dernière intervention: 29 juin 2012

- 25 juin 2012 à 11:30
Moun49800

Messages postés: 6
Date d'inscription: jeudi 31 mai 2012
Statut: Membre
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

A voir également:

[VBA]Trouver la valeur la plus proche (Heure)
SQL Server - Trouver toutes les valeurs superieurs à une heure donnée ✓ - Forum - SQL
Trouver la valeur superieure la plus proche ✓ - Forum - Visual Basic 6
Trouvé une valeur ds une colone sans find VBA excel2000 ✓ - Forum - Visual Basic
Excel vba trouver la dernière cellule non vide d'une colonne ✓ - Forum - Visual Basic 6
Vba copier coller valeur dans une autre feuille ✓ - Forum - Visual Basic

10 réponses

Réponse 2 / 10

NHenry

Messages postés: 14760
Date d'inscription: vendredi 14 mars 2003
Statut: Modérateur
Dernière intervention: 19 janvier 2021

151
25 juin 2012 à 12:43

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

Réponse 3 / 10

ucfoutu

Messages postés: 18038
Date d'inscription: lundi 7 décembre 2009
Statut: Modérateur
Dernière intervention: 11 avril 2018

233
25 juin 2012 à 12:44

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

Réponse 4 / 10

LIBRE_MAX

Messages postés: 1402
Date d'inscription: mardi 1 mai 2007
Statut: Membre
Dernière intervention: 7 octobre 2012

5
25 juin 2012 à 12:50

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.

Réponse 5 / 10

LIBRE_MAX

Messages postés: 1402
Date d'inscription: mardi 1 mai 2007
Statut: Membre
Dernière intervention: 7 octobre 2012

5
25 juin 2012 à 12:52

Bonjour Jacques,

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

[] Ce qui va sans dire. va mieux en le disant.

Réponse 6 / 10

Moun49800

Messages postés: 6
Date d'inscription: jeudi 31 mai 2012
Statut: Membre
Dernière intervention: 29 juin 2012

25 juin 2012 à 13:43

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.

Réponse 7 / 10

Moun49800

Messages postés: 6
Date d'inscription: jeudi 31 mai 2012
Statut: Membre
Dernière intervention: 29 juin 2012

25 juin 2012 à 14:44

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

Réponse 8 / 10

LIBRE_MAX

Messages postés: 1402
Date d'inscription: mardi 1 mai 2007
Statut: Membre
Dernière intervention: 7 octobre 2012

5
25 juin 2012 à 15:58

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.

Réponse 9 / 10

Moun49800

Messages postés: 6
Date d'inscription: jeudi 31 mai 2012
Statut: Membre
Dernière intervention: 29 juin 2012

25 juin 2012 à 17:50

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

Réponse 10 / 10

Moun49800

Messages postés: 6
Date d'inscription: jeudi 31 mai 2012
Statut: Membre
Dernière intervention: 29 juin 2012

26 juin 2012 à 13:30

Merci ucfoutu. J'ai un peut modifier mais sa marche

Merci tous le monde.

Répondre Posez votre question

ucfoutu · Accepted Answer · 2012-06-25T18:07:50+0200

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

Votre réponse