valeur proche dans ligne

sri75

XLDnaute Occasionnel
Bonjour, j'ai un tableau excel avec plus de 100 ligne et je cherche une macro pour recherche une valeur proche dans chaque ligne.

dans mon exemple j'ai en A10 la valeur 2.8 et je recherche la valeur la plus proche sur chaque ligne de mon classeur.

Quand le trouve la valeur la plus proche, je mets la cellule en rouge.

En fouillant dans les fils j'ai trouvé quelques modèles mais malheureusement je n'arrive pas à les adapter; merci à tous pour votre aide et suggestions.

Bonne journée

Stephane
 

Pièces jointes

  • valeur proche.xls
    27.5 KB · Affichages: 31
  • valeur proche.xls
    27.5 KB · Affichages: 38

CISCO

XLDnaute Barbatruc
Re : valeur proche dans ligne

Bonjour

Plus simplement avec une mise en forme conditionnelle
Code:
=ABS(B2-$A$10)=MIN(ABS($B2:$H2-$A$10))

@ plus
 

Pièces jointes

  • valeur proche.xls
    37 KB · Affichages: 45
  • valeur proche.xls
    37 KB · Affichages: 34

CISCO

XLDnaute Barbatruc
Re : valeur proche dans ligne

Bonjour


Va faire un petit tour dans l'onglet Accueil, puis dans "Mise en forme conditionnelle", puis dans "Gérer les règles", puis dans "Cette feuille de calcul" dans la liste déroulante.

@ plus
 

sri75

XLDnaute Occasionnel
Re : valeur proche dans ligne

ok vu, je voudrais mettre cette fonction dans une macro, où je rentrerais la valeur cherchée via une inputbox mais dans la macro ci-dessous visiblement ma valeur toto n'est pas prise en compte dans la formule "=ABS(B2-toto)=MIN(ABS($B2:$H2-toto))"

Merci pour ton aide


Sub pp()
'
' pp Macro
'

'
Dim toto As Single

toto = InputBox("entrez la valeur numerique")


Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=ABS(B2-toto)=MIN(ABS($B2:$H2-toto))"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Bold = False
.Italic = False
.Color = -16776961
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = True
End Sub
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : valeur proche dans ligne

Bonjour le fil, bonjour le forum,

Une solution par macro avec l'événementielle Change ci-dessous :

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim TV As Variant 'déclare la variable TV (Tavleu des valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Byte 'déclare la variable J (incrément)
Dim TD() As Variant 'déclare la variable TD (Tableau des Différences)
Dim TA() As Variant 'déclare la variable TA (Tableau des Adresses)
Dim K As Integer 'déclare la variable I (Incrément)

If Target.Address <> "$A$10" Then Exit Sub 'si le changement a lieu ailleurs qu'en A10, sort de la procédure
Cells.Interior.ColorIndex = xlNone 'enleve les éventuelles couleurs
If Target.Value = "" Then Exit Sub 'si A10 est effacée, sort de la procédure
TV = Range("A1").CurrentRegion 'définit le tableau des valeurs TV
For I = 2 To UBound(TV, 1) 'boucle 1 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    For J = 2 To UBound(TV, 2) 'boucle 2 : sur toutes les colonnes J du tableau des valeurs TV (en partant de la seconde)
        ReDim Preserve TD(K) 'redimensionne le tableau des différences TD (à une entrée)
        ReDim Preserve TA(1, K) 'redimensionne le tableau des adresses TA (a deux entrées)
        TD(K) = Abs(Target - TV(I, J)) 'recupère la valeur absolue de la différence entre A10 et la valeur ligne I colonne J du tableau des valeurs TV
        TA(0, K) = I 'récupère la ligne du tableau des valeurs TV
        TA(1, K) = J 'récupère la colonne du tableau des valeurs TV
        K = K + 1 'incrémente K
    Next J 'prochaine colonne de la boucle 2
Next I 'prochaine ligne de la boucle 1
For I = 0 To UBound(TD, 1) 'boucle sur toutes les différences u tableau TD
    'si la valeur TD(I) est égale à la valeur minimale des valeurs de ce tableau, colore la cellule correspondante de rouge
    If TD(I) = Application.WorksheetFunction.Min(TD) Then Cells(TA(0, I), TA(1, I)).Interior.ColorIndex = 3
Next I 'prochaine différence de la boucle
End Sub
Change la valeur dans la cellule A10...
 

Pièces jointes

  • Sri_v01.xls
    43 KB · Affichages: 25

CISCO

XLDnaute Barbatruc
Re : valeur proche dans ligne

Bonjour à tous, bonjour Robert

@ Robert : ton code a un style bien plus précis que les miens... J'ai encore du chemin à faire...

Ceci dit, j'ai l'impression que ta macro met en évidence les différences min pour tout le tableau, hors, il me semble, il faut faire cela ligne par ligne (Il doit donc y avoir au moins une cellule colorée par ligne). J'ai essayé de modifier ta macro en conséquence, mais cela ne fonctionne pas.

@ plus
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : valeur proche dans ligne

Bonjour le Fil, bonjour le forum,

@ Robert : ton code a un style bien plus précis que les miens... J'ai encore du chemin à faire...
Arf ! Maître CISCO qui plaisante avec centimètre Robert !... J'en ris encore...

Le code modifié pour chaque ligne (ça m'apprendra à ne pas relire l'énoncé...) :

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim TV As Variant 'déclare la variable TV (Tavleu des valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Byte 'déclare la variable J (incrément)
Dim TD() As Variant 'déclare la variable TD (Tableau des Différences)
Dim TA() As Variant 'déclare la variable TA (Tableau des Adresses)
Dim K As Integer 'déclare la variable I (Incrément)

If Target.Address <> "$A$10" Then Exit Sub 'si le changement a lieu ailleurs qu'en A10, sort de la procédure
Cells.Interior.ColorIndex = xlNone 'enleve les éventuelles couleurs
If Target.Value = "" Then Exit Sub 'si A10 est effacée, sort de la procédure
TV = Range("A1").CurrentRegion 'définit le tableau des valeurs TV
For I = 2 To UBound(TV, 1) 'boucle 1 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    K = 0: Erase TD: Erase TA:
    For J = 2 To UBound(TV, 2) 'boucle 2 : sur toutes les colonnes J du tableau des valeurs TV (en partant de la seconde)
        ReDim Preserve TD(K) 'redimensionne le tableau des différences TD (à une entrée)
        ReDim Preserve TA(1, K) 'redimensionne le tableau des adresses TA (a deux entrées)
        TD(K) = Abs(Target - TV(I, J)) 'recupère la valeur absolue de la différence entre A10 et la valeur ligne I colonne J du tableau des valeurs TV
        TA(0, K) = I 'récupère la ligne du tableau des valeurs TV
        TA(1, K) = J 'récupère la colonne du tableau des valeurs TV
        K = K + 1 'incrémente K
    Next J 'prochaine colonne de la boucle 2
    For K = 0 To UBound(TD, 1) 'boucle sur toutes les différences u tableau TD
        'si la valeur TD(K) est égale à la valeur minimale des valeurs de ce tableau, colore la cellule correspondante de rouge
        If TD(K) = Application.WorksheetFunction.Min(TD) Then Cells(TA(0, K), TA(1, K)).Interior.ColorIndex = 3
    Next K 'prochaine différence de la boucle
Next I 'prochaine ligne de la boucle 1
End Sub
 

sri75

XLDnaute Occasionnel
Re : valeur proche dans ligne

Merci pour ce code, c'est effectivement très impressionnant !

Pour ma culture personnelle , auriez vous une solution pur mon probleme de quote dans le code ci-dessous ?

Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=ABS(B2-toto)=MIN(ABS($B2:$H2-toto))"


Merci pour vos recherches, je suis encore très loin de votre niveau
 

sri75

XLDnaute Occasionnel
Re : valeur proche dans ligne

Bonjour, je voudrais adapter ce dernier code ci-dessous :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim TV As Variant 'déclare la variable TV (Tavleu des valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Byte 'déclare la variable J (incrément)
Dim TD() As Variant 'déclare la variable TD (Tableau des Différences)
Dim TA() As Variant 'déclare la variable TA (Tableau des Adresses)
Dim K As Integer 'déclare la variable I (Incrément)

If Target.Address <> "$A$10" Then Exit Sub 'si le changement a lieu ailleurs qu'en A10, sort de la procédure
Cells.Interior.ColorIndex = xlNone 'enleve les éventuelles couleurs
If Target.Value = "" Then Exit Sub 'si A10 est effacée, sort de la procédure
TV = Range("A1").CurrentRegion 'définit le tableau des valeurs TV
For I = 2 To UBound(TV, 1) 'boucle 1 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
K = 0: Erase TD: Erase TA:
For J = 2 To UBound(TV, 2) 'boucle 2 : sur toutes les colonnes J du tableau des valeurs TV (en partant de la seconde)
ReDim Preserve TD(K) 'redimensionne le tableau des différences TD (à une entrée)
ReDim Preserve TA(1, K) 'redimensionne le tableau des adresses TA (a deux entrées)
TD(K) = Abs(Target - TV(I, J)) 'recupère la valeur absolue de la différence entre A10 et la valeur ligne I colonne J du tableau des valeurs TV
TA(0, K) = I 'récupère la ligne du tableau des valeurs TV
TA(1, K) = J 'récupère la colonne du tableau des valeurs TV
K = K + 1 'incrémente K
Next J 'prochaine colonne de la boucle 2
For K = 0 To UBound(TD, 1) 'boucle sur toutes les différences u tableau TD
'si la valeur TD(K) est égale à la valeur minimale des valeurs de ce tableau, colore la cellule correspondante de rouge
If TD(K) = Application.WorksheetFunction.Min(TD) Then Cells(TA(0, K), TA(1, K)).Interior.ColorIndex = 3
Next K 'prochaine différence de la boucle
Next I 'prochaine ligne de la boucle 1
End Sub


Je voudrais que ma cellule de réference soit A1 et non A10, et que le début de mon tableau pris dans TV soit en C1

Si dans le code je mets C1 au lieu de A1 et A1 au lieu de A10 ca ne fonctionne plus !

Merci pour votre aide
 

sri75

XLDnaute Occasionnel
Re : valeur proche dans ligne

Je voudrais faire un copier coller d'un tableau existant dans ma feuille .

Pour ca j'avais pensé mettre ma valeur de reference en A1 puis faire mon coller en C1 pour que ma valeur de référence ne soit pas collée au tableau, mais rien n'est bloqué

Merci
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : valeur proche dans ligne

Bonjour le fil, bonjour le forum,

Si tu décales le tableau en C1, la colonne J doit être décalée de 2. La ligne :

Code:
 TA(1, K) = J  'récupère la colonne du tableau des valeurs TV
devient :
Code:
TA(1, K) = J + 2 'récupère la colonne (plus deux) du tableau des valeurs TV

Le fichier :
 

Pièces jointes

  • Sri_v02.xls
    39.5 KB · Affichages: 35

sri75

XLDnaute Occasionnel
Re : valeur proche dans ligne

je voudrais savoir s'l est possible de faire les choses suivantes :

Faire travailler ce programme dans un tableau qui contient également des données non numériques ( ex un nom ).

Par rapport au montant recherché, est il possible de mettre une fourchette ( ex de recherche 100 mais je ne colorie que les zones a + ou moins 10 ( 90 ou 100 ). Actuellement si je cherche 100 et que dans la migne le chiffre le plus approchant est 100.000 il va colorier 100.000.

Enfin est il possible d'inserer une variable vba dans le code pour le point de départ du tableau

TV = Range("C1").CurrentRegion

ex je saisis 4 en A4 et dans mon code j'aurais TV = Range("C4").CurrentRegion

j'ai essayé avec un exemple ou mon tableau commence en h1 ( valeur saisie en A3 ) mais ca ne fonctionne pas

Merci beaucoup et bonne journée
 

Pièces jointes

  • Sri_v03.xls
    38 KB · Affichages: 26
  • Sri_v03.xls
    38 KB · Affichages: 24
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 300
Messages
2 087 008
Membres
103 429
dernier inscrit
PhilippeH