[VBA]Trouver la valeur la plus proche (Heure) [Résolu]
Moun49800
Membre Dernière intervention
29 juin 2012
- - Dernière réponse :
Moun49800
Membre Dernière intervention
29 juin 2012
- 26 juin 2012 à 13:30
- Messages postés
- 6
- Date d'inscription
- jeudi 31 mai 2012
- Statut
- Messages postés
- 6
- Date d'inscription
- jeudi 31 mai 2012
- Statut
A voir également:
- If not is nothing then vba
- Is not nothing vba - Meilleures réponses
- 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
- Un logiciel qui trouve la valeur d'une résistance en ohms - Codes sources - Visual Basic / VB.NET (Divers)
- [vba] recopier la valeur d'une cellule dans une autre feuille. ✓ - Forum - Visual Basic
10 réponses
Meilleure réponse
- Messages postés
- 18039
- Date d'inscription
- lundi 7 décembre 2009
- Statut
Je t'ai fait un petit exemple de recherche du ton plus petit écart dans la colonne A :
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
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
Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire
139 internautes nous ont dit merci ce mois-ci
- Messages postés
- 14444
- Date d'inscription
- vendredi 14 mars 2003
- Statut
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
---
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
---
- Messages postés
- 18039
- Date d'inscription
- lundi 7 décembre 2009
- Statut
Bonjour,
1) Avant toute autre chose : je déplore que tu aies ouvert la présente discussion dans la section
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
1) Avant toute autre chose : je déplore que tu aies ouvert la présente discussion dans la section
Forum > VB.NET et VB 2005qui 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
- Messages postés
- 1403
- Date d'inscription
- mardi 1 mai 2007
- Statut
Bonjour,
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.
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.
- Messages postés
- 6
- Date d'inscription
- jeudi 31 mai 2012
- Statut
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 ):
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
- Messages postés
- 1403
- Date d'inscription
- mardi 1 mai 2007
- Statut
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.
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.
- Messages postés
- 6
- Date d'inscription
- jeudi 31 mai 2012
- Statut
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 :
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
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
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.