Associer valeur en fonction de bornes inconnues

Bonjour,

Novice en VBA, je viens vous solliciter.

J'ai l'idée précise mais j'ai besoin d'un coup de pousse pour l'exécuter.

Voici mon raisonnement :

- si valeur de colonne A ligne 2 compris entre borne en I2 et J2 alors on copie colle la valeur de H2 en C2 sinon on continue I3 J3 pour trouver les bornes et la valeur à associer

Je n'arrive pas à déposer le fichier car il est trop volumineux me dit l'interface.

Merci d'avance

Bonjour Quinetenterien,

En PJ un classeur maquette tentant de reproduire ton problème.

Et le code de recherche associé:

Sub searchValue()
    Const cColFrom = 3       'Constante indiquant le N° relatif de colonne du tableau contenant les valeurs de début
    Const cColTo = 4         'Constante indiquant le N° relatif de colonne du tableau contenant les valeurs de fin
    Const cColValue = 1      'Constante indiquant le N° relatif de colonne du tableau contenant les valeurs à renvoyer

    Dim oSource As Range, oCible As Range, oLO As ListObject, oRow As Range 'Déclaration des variables objets
    Dim oSheet As Worksheet

    Set oSheet = ThisWorkbook.Sheets(1)     'GVS: Ajuster le numéro de feuille le cas échéant
    With oSheet
        Set oSource = ThisWorkbook.Worksheets(1).Range("A2")
        Set oCible = ThisWorkbook.Worksheets(1).Range("C2")

        Set oLO = .ListObjects("MonTableau")
        For Each oRow In oLO.DataBodyRange.Rows
            'MsgBox oRow.Cells(1, cColFrom).Value & " " & oRow.Cells(1, cColTo).Value
            If oRow.Cells(1, cColFrom).Value <= oSource.Value And oRow.Cells(1, cColTo).Value >= oSource.Value Then
                oCible.Value = oRow.Cells(1, cColValue).Value
                Exit For
            End If
        Next
    End With

     'On fait le ménage
    Set oRow = Nothing
    Set oLO = Nothing
    Set oSheet = Nothing
    Set oSource = Nothing
    Set oCible = Nothing
End Sub

Sinon, t'as raison : n'arien

Bonsoir,

C'est exactement ce que j'avais commencé à faire mais en beaucoup moins bien

J'ai essayé de la faire marcher mais la recherche marche que pour le la cellule C2 (dans votre fichier).

normalement la macro devrait prendre la ligne suivante mais ça ne fonctionne pas…

J'ai associé mon fichier à ce message car ça ne marche pas du tout pour le coup sur le mien.

(ça fait 30minutes que j'essaye de comprendre mais je perds du temps plus qu'autre chose).

Merci beaucoup pour la réactivité !

Quinetenterien n'arien

Bonjour Quinetenterien,

En P.J. une version adaptée et le code :

Sub searchValue()
    Const cColFrom = 3       'Constante indiquant le N° relatif de colonne du tableau contenant les valeurs de début
    Const cColTo = 4         'Constante indiquant le N° relatif de colonne du tableau contenant les valeurs de fin
    Const cColValue = 1      'Constante indiquant le N° relatif de colonne du tableau contenant les valeurs à renvoyer

    Dim oSource As Range, oCible As Range, oLO As ListObject, oRow As Range, oCell As Range 'Déclaration des variables objets
    Dim oSheet As Worksheet

    Set oSheet = ThisWorkbook.Sheets(1)     'GVS: Ajuster le numéro de feuille le cas échéant
    With oSheet
        Set oSource = ThisWorkbook.Worksheets(1).UsedRange.Columns(1)
        Set oLO = .ListObjects("MonTableau")
        For Each oCell In oSource.Cells
            If oCell.Row > 1 Then   'On Saute la ligne de titre
                For Each oRow In oLO.DataBodyRange.Rows
                    If oRow.Cells(1, cColFrom).Value <= oCell.Value And oRow.Cells(1, cColTo).Value >= oCell.Value Then
                        Set oCible = oCell.Offset(0, 2)
                        oCible.Value = oRow.Cells(1, cColValue).Value
                        Exit For
                    End If
                Next
            End If
        Next
    End With

     'On fait le ménage
    Set oRow = Nothing
    Set oLO = Nothing
    Set oSheet = Nothing
    Set oSource = Nothing
    Set oCible = Nothing
    Set oCell = Nothing
End Sub

Merci beaucoup !!! les 60 000 lignes ont été traitées en quelques secondes !!

BRAVO et merci pour la réactivité !