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

Question

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&#8217;emploie pas les bon termes. 

Voici le petit problème qui m&#8217;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

ucfoutu · Accepted Answer

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

NHenry · Answer

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

ucfoutu · Answer

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

LIBRE_MAX · Answer

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.

LIBRE_MAX · Answer

Bonjour Jacques,

Même idée alors..
En retard, une fois de plus !

[] Ce qui va sans dire. va mieux en le disant.

Moun49800 · Answer

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.

Moun49800 · Answer

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

LIBRE_MAX · Answer

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.

Moun49800 · Answer

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

Moun49800 · Answer

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

[VBA]Trouver la valeur la plus proche (Heure)

10 réponses

Votre réponse

Discussions similaires