Récupération de données par RechercheV()

Eusèbe65

XLDnaute Nouveau
Bonjour,

Voici donc mon problème ( fichier exemple joint ) sur EXCEL 2016

La feuille DATA contient les données de base et la feuille CORRESPONDANCE contient les données à récupérer.
Les données à récupérer sont " Code d'éco-participation" et "Montant HT" .
Ces données sont à récupérer depuis CORRESPONDANCE vers DATA, en fonction de la colonne "Code Douane" ET "Poids en KGM".
Le problème est que dans CORRESPONDANCE pour un code douane, il peut y avoir jusqu'à 5 fourchettes de poids différences. Et il me faut récupérer la bonne en fonction du poids de Data.

Si vous avez une idée sur comment faire, vous m'enlevez une épine énorme du pied !!

Merci par avance de votre aide.
 

Pièces jointes

  • Eco-participations.xlsx
    117.3 KB · Affichages: 18
Dernière édition:

CHALET53

XLDnaute Barbatruc
Bonjour
La formule ci-dessous en modifiant la feuille correspondance : insérer une colonne après la colonne B et décomposer la colonne B pour :
Laisser la colonne B avec le poids mini
Mettre le poids maxi en colonne C
Comme ceci :
Mini Maxi
0 1
1 5
5 20
20 120
120 999999


=SOMMEPROD((Correspondance!$A$2:$A$860=C3)*(Correspondance!$B$2:$B$860<=B3)*(Correspondance!$C$2:$C$860>B3)*(Correspondance!E2:E860))


A+
 

Eusèbe65

XLDnaute Nouveau
Tout d'abord merci pour cet effort.

J'ai tout de même des choses bizarres : en prenant le code douane 65061010, j'obtiens un montant de 2, et là je ne vois pas d'où il vient.
Autre chose : savez-vous comment remonter retrouver également me code "Eco-participation" ??

Merci encore pour cette aide.




Bonjour
La formule ci-dessous en modifiant la feuille correspondance : insérer une colonne après la colonne B et décomposer la colonne B pour :
Laisser la colonne B avec le poids mini
Mettre le poids maxi en colonne C
Comme ceci :
Mini Maxi
0 1
1 5
5 20
20 120
120 999999


=SOMMEPROD((Correspondance!$A$2:$A$860=C3)*(Correspondance!$B$2:$B$860<=B3)*(Correspondance!$C$2:$C$860>B3)*(Correspondance!E2:E860))


A+
 

job75

XLDnaute Barbatruc
Bonjour Eusèbe65, CHALET53,

Voici un code VBA à placer dans le module de la feuille "Data" (clic droit sur l'onglet et Visualiser le code) :
Code:
Private Sub Worksheet_Activate()
Dim resu, source, d As Object, i&, poids$, s, j&, lig&, sk, OK As Boolean, k%
resu = [A1].CurrentRegion.Resize(, 6)
source = Sheets("Correspondance").[A1].CurrentRegion.Resize(, 4).Value2
Set d = CreateObject("Scripting.Dictionary")
'---mémorisation du tableau source
For i = 2 To UBound(source)
    d(CStr(source(i, 1))) = d(CStr(source(i, 1))) & " " & i 'liste des numéros de lignes
Next i
'---tableau resu---
For i = 2 To UBound(resu)
    poids = Replace(resu(i, 2), ",", ".")
    s = Split(d(CStr(resu(i, 3))))
    For j = 1 To UBound(s)
        lig = Val(s(j))
        If source(lig, 2) = "-" Then
            resu(i, 4) = source(lig, 3)
            resu(i, 5) = source(lig, 4)
            Exit For
        Else
            sk = Split(Replace(Replace(Replace(source(lig, 2), "kg", ""), "l", ""), ",", "."), "et")
            OK = True
            For k = 0 To UBound(sk)
                If Asc(sk(k)) = 61 Then sk(k) = "<=" & Mid(sk(k), 2) 'le caractère <= n'est pas reconnu...
                If Not Evaluate(poids & sk(k)) Then OK = False: Exit For
            Next k
            If OK Then
                resu(i, 4) = source(lig, 3)
                resu(i, 5) = source(lig, 4)
                Exit For
            End If
        End If
Next j, i
'---restitution---
[D1].Resize(UBound(resu)) = Application.Index(resu, , 4)
[E1].Resize(UBound(resu)) = Application.Index(resu, , 5)
End Sub
J'ai un peu galéré avec la colonne B de la feuille "Corespondance" car VBA ne reconnaît pas le signe <=.

Fichier joint.

A+
 

Pièces jointes

  • Eco-participations(1).xlsm
    133.7 KB · Affichages: 13

job75

XLDnaute Barbatruc
Bonjour Eusèbe65, le forum,

Prenez cette version (2), le code est plus concis :
Code:
Private Sub Worksheet_Activate()
Dim resu, source, d As Object, i&, s, j&, lig&, OK As Boolean, poids$, sk, k%
resu = [A1].CurrentRegion.Resize(, 5)
source = Sheets("Correspondance").[A1].CurrentRegion.Resize(, 4).Value2
Set d = CreateObject("Scripting.Dictionary")
'---mémorisation du tableau source
For i = 2 To UBound(source)
    d(CStr(source(i, 1))) = d(CStr(source(i, 1))) & " " & i 'liste des numéros de lignes
Next i
'---tableau resu---
For i = 2 To UBound(resu)
    s = Split(d(CStr(resu(i, 3))))
    For j = 1 To UBound(s)
        lig = Val(s(j))
        OK = True
        If source(lig, 2) <> "-" Then
            poids = Replace(resu(i, 2), ",", ".")
            sk = Split(Replace(Replace(Replace(source(lig, 2), "kg", ""), "l", ""), ",", "."), "et")
            For k = 0 To UBound(sk) '0 ou 1
                If Asc(sk(k)) = 61 Then sk(k) = "<=" & Mid(sk(k), 2) 'le caractère <= n'est pas reconnu...
                If Not Evaluate(poids & sk(k)) Then OK = False: Exit For
            Next k
        End If
        If OK Then
            resu(i, 4) = source(lig, 3)
            resu(i, 5) = source(lig, 4)
            Exit For
        End If
Next j, i
'---restitution---
[D1].Resize(UBound(resu)) = Application.Index(resu, , 4)
[E1].Resize(UBound(resu)) = Application.Index(resu, , 5)
End Sub
Plus concis mais pas plus rapide : chez moi la macro s'exécute en 0,83 seconde.

A+
 

Pièces jointes

  • Eco-participations(2).xlsm
    134 KB · Affichages: 10

Eusèbe65

XLDnaute Nouveau
Bonjour, Job75,

Votre solution me plait beaucoup.
Je n'y connais rien à VBA et l'adaptation à mon fichier final me pose des problèmes.
Puis-je abuser de vous demander l'adaptation de votre code à ce format de feuille ? Le fichier que j'avais joint était simplifié, celui-ci a plus de colonnes.

Merci à nouveau par avance pour votre précieuse aide !!!
 

Pièces jointes

  • EMOS 2018TEST.xlsx
    435 KB · Affichages: 9

job75

XLDnaute Barbatruc
Re,

Avec ce nouveau fichier beaucoup de Codes Douane de la feuille "Data" n'ont pas de correspondance dans la 2ème feuille.

Il faut donc effacer au départ les colonnes P et Q (RAZ).

Et il faut bien sûr adapter le tableau resu aux colonnes 6 (F) 11 (K) 16 (P) et 17 (Q) :
Code:
Private Sub Worksheet_Activate()
Dim resu, source, d As Object, i&, s, j&, lig&, OK As Boolean, poids$, sk, k%
Application.ScreenUpdating = False
With [A1].CurrentRegion.Resize(, 17)
    .Columns(16).Resize(, 2).Offset(1).ClearContents 'RAZ des colonnes P et Q
    resu = .Value
End With
source = Sheets("Correspondance").[A1].CurrentRegion.Resize(, 5).Value2
Set d = CreateObject("Scripting.Dictionary")
'---mémorisation du tableau source
For i = 2 To UBound(source)
    d(CStr(source(i, 1))) = d(CStr(source(i, 1))) & " " & i 'liste des numéros de lignes
Next i
'---tableau resu---
For i = 2 To UBound(resu)
    s = Split(d(CStr(resu(i, 11))))
    For j = 1 To UBound(s)
        lig = Val(s(j))
        OK = True
        If source(lig, 2) <> "-" Then
            poids = Replace(resu(i, 6), ",", ".")
            sk = Split(Replace(Replace(Replace(source(lig, 2), "kg", ""), "l", ""), ",", "."), "et")
            For k = 0 To UBound(sk) '0 ou 1
                If Asc(sk(k)) = 61 Then sk(k) = "<=" & Mid(sk(k), 2) 'le caractère <= n'est pas reconnu...
                If Not Evaluate(poids & sk(k)) Then OK = False: Exit For
            Next k
        End If
        If OK Then
            resu(i, 16) = source(lig, 3)
            resu(i, 17) = source(lig, 4)
            Exit For
        End If
Next j, i
'---restitution---
[P1].Resize(UBound(resu)) = Application.Index(resu, , 16)
[Q1].Resize(UBound(resu)) = Application.Index(resu, , 17)
End Sub
Pour ceux que ça intéresse, quand il n'y a pas de correspondance dans la 2ème feuille Ubound(s) = -1.

A+
 

Pièces jointes

  • EMOS 2018TEST(1).xlsm
    369.1 KB · Affichages: 10

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 924
Membres
101 841
dernier inscrit
ferid87