Macro Faire référence à une valeur si comprise dans une plage

Bonjour à tous,

Je souhaite effectuer une macro qui:

- recherchera si les valeurs de la colonne A 'feuil1' sont comprises dans une des plages de la 'feuil2' borne min colonne F et borne max colonne G

Si oui alors:

- remonter l'information de la colonne B 'feuil2' dans la colonne B'feuil1')

- remonter l'information de la colonne C 'feuil2' dans la colonne C 'feuil1')

A noter que je dois appliquer ceci à un table de donnée contenant 34 000 lignes.... il me faut donc une macro fiable et rapide....

Please help :)

Merci d'avance,

Alex

Salut Alexandre,

ainsi, sans doute ?
Un double clic sur la feuille 'BDD' démarre la macro.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tTab, tB
'
Cancel = True
Application.ScreenUpdating = False
'
Range("B2:C" & Range("A" & Rows.Count).End(xlUp).Row).Value = ""
tTab = Range("A2:C" & Range("A" & Rows.Count).End(xlUp).Row).Value
tB = Worksheets("BORNES").Range("A3:G" & Worksheets("BORNES").Range("B" & Rows.Count).End(xlUp).Row).Value
'
For x = 1 To UBound(tTab, 1)
    For y = 1 To UBound(tB, 1)
        If CDbl(tTab(x, 1)) >= CDbl(tB(y, 7)) And CDbl(tTab(x, 1)) <= CDbl(tB(y, 6)) Then _
            tTab(x, 2) = tB(y, 2): _
            tTab(x, 3) = tB(y, 3)
    Next
Next
Range("A2").Resize(UBound(tTab, 1), 3).Value = tTab
'
Application.ScreenUpdating = True
'
End Sub

A+

Magnifique :)

Merci beaucoup !

Oups j'ai répondu un peu vite.

J'ai appliqué ta macro sur mon fichier. Les n° de colonne et format sont identiques au fichier test.

Cependant, il ne me reporte aucune donnée.

A noter que les valeurs du fichier Test sont issues des données réel (nombre à vérifier dans les range).

Sans ton fichier, difficile de deviner ce qui cloche... !!

Voilà le fichier.

Ah, ces fichiers-exemples tellement représentatifs !
Mêmes colonnes, mêmes lignes, certes... mais les colonnes de dates de début et fin ont été inversées ! Malin

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tTab, tB
'
Cancel = True
Application.ScreenUpdating = False
'
Range("B2:C" & Range("A" & Rows.Count).End(xlUp).Row).Value = ""
tTab = Range("A2:C" & Range("A" & Rows.Count).End(xlUp).Row).Value
tB = Worksheets("BORNES").Range("A3:G" & Worksheets("BORNES").Range("B" & Rows.Count).End(xlUp).Row).Value
'
For x = 1 To UBound(tTab, 1)
    For y = 1 To UBound(tB, 1)
        If CDbl(tTab(x, 1)) >= CDbl(tB(y, 6)) And CDbl(tTab(x, 1)) <= CDbl(tB(y, 7)) Then _
            tTab(x, 2) = tB(y, 2): _
            tTab(x, 3) = tB(y, 3)
    Next
Next
Range("A2").Resize(UBound(tTab, 1), 3).Value = tTab
'
Application.ScreenUpdating = True
'
End Sub

A+

ahahah j'ai honte....merci ca fonctionne a merveille!

bonnes fêtes de fin d'année.