XL 2013 Multi VLOOKUP

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion brunos31
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
B

brunos31

Guest
Bonjour à tous,

Je me posé une question, à savoir si il est possible de générer un tableau en recherchev selon plusieurs critères en VBA.

Je m'explique. J'ai un tableau qui regarde un certains nombre d'item dans une feuille "Table", si l'item trouvé à la valeur qui match avec le mot qui est stocké sur une autre feuille "Dashboard", il remonte dans le tableau. Puis par rapport à ce numéros d'item, il doit chercher une valeur correspondante en croisant les données tel que la date et un type de travaux donnée.

Je pense que le fichier join ne sera pas de trop pour vous montrer plus précisément ce que je cherche ^^


Merci d'avance pour votre aide.
 

Pièces jointes

Trier par date Trier par votes
bonjour
Bruno bienvenue
une solution
Code: 
Sub suite()
    Dim L As Long, C As Long
    Dim Cel As Range, Cel1 As Range

    For Each Cel In Sheets("PROD").Range("A1:Q1")   'date 18-12-17
        If Cel = Sheets("Matrice").Range("BJ1") Then C = Cel.Column: Exit For
    Next
    If C > 0 Then    '88
        For Each Cel1 In Sheets("Matrice").Range("BK1:BT1")
            For Each Cel In Sheets("PROD").Range("A2:A11")
                If Left(Cel, Len(Cel1)) = Cel1 Then L = Cel.Row: Exit For
            Next
            Sheets("Matrice").Cells(2, Cel1.Column) = Sheets("PROD").Cells(L, C)
        Next
    End If

    For Each Cel In Sheets("PROD").Range("A12:Q12")   'date 18-12-17
        If Cel = Sheets("Matrice").Range("BJ1") Then C = Cel.Column: Exit For
    Next
    If C > 0 Then    '132
        For Each Cel1 In Sheets("Matrice").Range("BK1:BT1")
            For Each Cel In Sheets("PROD").Range("A13:A22")
                If Left(Cel, Len(Cel1)) = Cel1 Then L = Cel.Row: Exit For
            Next
            Sheets("Matrice").Cells(3, Cel1.Column) = Sheets("PROD").Cells(L, C)
        Next
    End If

End Sub
 
Vote positif 0 Vote négatif
Bonjour Bebere,

Merci beaucoup pour ton aide. Je modifie le script pour avoir une boucle toutes les 11 lignes, car le nombre d'item dans la feuille "PROD" est inconnue, seul le nombre de ligne entre nouveau item est constant, soit toutes les 11 lignes.

VB: 
Option Explicit
Sub test()
'--------------------------------------------------------------------------------------------------------------------------
'Variable
'--------------------------------------------------------------------------------------------------------------------------
  Dim suite As Range 'variable range
  Dim cellule As Range 'variable range
  Dim value1 As Range 'variable text
  Dim L As Long, C As Long
  Dim Cel As Range, Cel1 As Range
  Dim i As Long
  Dim DerniereLigne As Long
'--------------------------------------------------------------------------------------------------------------------------
'MSN link to SCOPE
'--------------------------------------------------------------------------------------------------------------------------
  'Source value
  Set value1 = Sheets("Dashboard").Range("A2")
  'Search the value in extract tab
  For Each cellule In Sheets("Table").Range("Q2:Q" & Sheets("Table").Range("A65535").End(xlUp).Row)
  Set suite = Sheets("Matrice").[BJ65536].End(xlUp).Offset(1, 0)
  If cellule = value1 Then
  'Write the resultat
  Sheets("Matrice").Range("BJ" & Sheets("Matrice").Range("BJ65535").End(xlUp).Row + 1) = Sheets("Table").Cells(cellule.Row, 1)
  End If
  Next
'--------------------------------------------------------------------------------------------------------------------------
'Consolidation Hours
'-------------------------------------------------------------------------------------------------------------------------
DerniereLigne = Range("A65536").End(xlUp).Row
For i = 1 To DerniereLigne Step 11
  For Each Cel In Sheets("PROD").Range("A" & i & ":Q" & i + 11)
  If Cel = Sheets("Matrice").Range("BJ1") Then C = Cel.Column: Exit For
  Next

  If C > 0 Then
  For Each Cel1 In Sheets("Matrice").Range("BK1:BT1")
  For Each Cel In Sheets("PROD").Range("A" & i & ":A" & i + 11)
  If Left(Cel, Len(Cel1)) = Cel1 Then L = Cel.Row: Exit For
  Next
  Sheets("Matrice").Cells(2, Cel1.Column) = Sheets("PROD").Cells(L, C)
  Next
  End If
Next i
'--------------------------------------------------------------------------------------------------------------------------
'Clear memory system
'--------------------------------------------------------------------------------------------------------------------------
  Set Cel = Nothing
  Set Cel1 = Nothing
  Set suite = Nothing
  Set cellule = Nothing
  Set value1 = Nothing
End Sub
 

Pièces jointes

Dernière modification par un modérateur:
Vote positif 0 Vote négatif
bonjour
Bruno mis les heures au format hh:mm,pour moi suite n'est pas utile
Code: 
Sub test()
'--------------------------------------------------------------------------------------------------------------------------
'Variable
'--------------------------------------------------------------------------------------------------------------------------
'    Dim suite As Range 'variable range
    Dim cellule As Range 'variable range
    Dim value1 As Range 'variable text
    Dim L As Long, Li As Long, C As Long
    Dim Cel As Range, Cel1 As Range
    Dim derligne As Integer
    Dim i As Byte
'--------------------------------------------------------------------------------------------------------------------------
'MSN link to SCOPE
'--------------------------------------------------------------------------------------------------------------------------
  'Source value
  Set value1 = Sheets("Dashboard").Range("A2")
  'Search the value in extract tab
  For Each cellule In Sheets("Table").Range("Q2:Q" & Sheets("Table").Range("A65535").End(xlUp).Row)
'  Set suite = Sheets("Matrice").[BJ65536].End(xlUp).Offset(1, 0)
  If cellule = value1 Then
  'Write the resultat
  Sheets("Matrice").Range("BJ" & Sheets("Matrice").Range("BJ65535").End(xlUp).Row + 1) = Sheets("Table").Cells(cellule.Row, 1)
  End If
  Next
'--------------------------------------------------------------------------------------------------------------------------
'Consolidation Hours
'-------------------------------------------------------------------------------------------------------------------------
derligne = Sheets("PROD").Cells(65000, 1).End(xlUp).Row
Li = 2
For i = 1 To derligne Step 11
If IsDate(Sheets("PROD").Cells(i, 2)) Then
    For Each Cel In Sheets("PROD").Range("A" & i & ":Q" & i)
        If Cel = Sheets("Matrice").Range("BJ1") Then C = Cel.Column: Exit For
    Next
    If C > 0 Then
        For Each Cel1 In Sheets("Matrice").Range("BK1:BT1")
            For Each Cel In Sheets("PROD").Range("A" & i + 1 & ":A" & i + 10)
                If Left(Cel, Len(Cel1)) = Cel1 Then L = Cel.Row: Exit For
            Next
            Sheets("Matrice").Cells(Li, Cel1.Column) = CDate(Sheets("PROD").Cells(L, C) / 24)
            Sheets("Matrice").Cells(Li, Cel1.Column).NumberFormat = "[hh]:mm"
        Next
    End If
End If
Li = Li + 1
Next i
'--------------------------------------------------------------------------------------------------------------------------
'Clear memory system
'--------------------------------------------------------------------------------------------------------------------------
  Set Cel = Nothing
  Set Cel1 = Nothing
  Set suite = Nothing
  Set cellule = Nothing
  Set value1 = Nothing
End Sub
 
Vote positif 0 Vote négatif
Merci Bebere,

J'ai remodifier, j'ai pas besoin d'avoir un affichage par heure car j'ai des valeurs pour le nombre de personne voulu et un nombre d'heure. Mais c'est gentil, c'est bon à savoir.

Par contre il me rajoute une ligne en plus à la fin dans le vide.... Je vais essayer de voir d'où vient ce bug.

VB: 
derligne = Sheets("PROD").Cells(65000, 1).End(xlUp).Row
Li = 2
For i = 1 To derligne Step 11
If IsDate(Sheets("PROD").Cells(i, 2)) Then
    For Each Cel In Sheets("PROD").Range("A" & i & ":Q" & i)
        If Cel = Sheets("Matrice").Range("BJ1") Then C = Cel.Column: Exit For
    Next
    If C > 0 Then
        For Each Cel1 In Sheets("Matrice").Range("BK1:BT1")
            For Each Cel In Sheets("PROD").Range("A" & i + 1 & ":A" & i + 10)
                If Left(Cel, Len(Cel1)) = Cel1 Then L = Cel.Row: Exit For
            Next
            Sheets("Matrice").Cells(Li, Cel1.Column) = CDate(Sheets("PROD").Cells(L, C))
            Sheets("Matrice").Cells(Li, Cel1.Column).NumberFormat = "0.0"
        Next
    End If
End If
Li = Li + 1
Next i

Merci beaucoup de ton aide
 

Pièces jointes

Vote positif 0 Vote négatif
Je pense savoir d'où ça vient, il manque une première loop. Qui consiste à prendre uniquement le numéros d'item qui est flagé "FL" (valeur cherché en sheets("Dashboard").Range("A2")) dans la feuille "TABLE"
 
Vote positif 0 Vote négatif
bonsoir
Bruno regarde les 2 lignes commentées ajout
Code: 
Sub test()
'--------------------------------------------------------------------------------------------------------------------------
'Variable
'--------------------------------------------------------------------------------------------------------------------------
'    Dim suite As Range 'variable range
    Dim cellule As Range 'variable range
    Dim value1 As Range 'variable text
    Dim L As Long, Li As Long, C As Long
    Dim Cel As Range, Cel1 As Range
    Dim derligne As Integer
    Dim i As Byte, x
    Sheets("Matrice").Range("BJ2:BT" & Sheets("Matrice").Range("BJ65535").End(xlUp).Row).ClearContents 'ajout
'--------------------------------------------------------------------------------------------------------------------------
'MSN link to SCOPE
'--------------------------------------------------------------------------------------------------------------------------
  'Source value
  Set value1 = Sheets("Dashboard").Range("A2")
  'Search the value in extract tab
  For Each cellule In Sheets("Table").Range("Q2:Q" & Sheets("Table").Range("A65535").End(xlUp).Row)
'  Set suite = Sheets("Matrice").[BJ65536].End(xlUp).Offset(1, 0)
  If cellule = value1 Then
  'Write the resultat
  Sheets("Matrice").Range("BJ" & Sheets("Matrice").Range("BJ65535").End(xlUp).Row + 1) = Sheets("Table").Cells(cellule.Row, 1)
  End If
  Next
'--------------------------------------------------------------------------------------------------------------------------
'Consolidation Hours
'-------------------------------------------------------------------------------------------------------------------------
derligne = Sheets("PROD").Cells(65000, 1).End(xlUp).Row
Li = 2
For i = 1 To derligne Step 11
If IsDate(Sheets("PROD").Cells(i, 2)) Then
    For Each Cel In Sheets("PROD").Range("A" & i & ":Q" & i)
        If Cel = Sheets("Matrice").Range("BJ1") Then C = Cel.Column: Exit For
    Next
    If C > 0 Then
        For Each Cel1 In Sheets("Matrice").Range("BK1:BT1")
            For Each Cel In Sheets("PROD").Range("A" & i + 1 & ":A" & i + 10)
                If Left(Cel, Len(Cel1)) = Cel1 Then L = Cel.Row: Exit For
            Next
            Sheets("Matrice").Cells(Li, Cel1.Column) = CDate(Sheets("PROD").Cells(L, C) / 24)
            Sheets("Matrice").Cells(Li, Cel1.Column).NumberFormat = "[hh]:mm"
        Next
    End If
End If
Li = Li + 1
If Sheets("Matrice").Range("BJ" & Li) = "" Then Exit For 'ajout
Next i
'--------------------------------------------------------------------------------------------------------------------------
'Clear memory system
'--------------------------------------------------------------------------------------------------------------------------
  Set Cel = Nothing
  Set Cel1 = Nothing
'  Set suite = Nothing
  Set cellule = Nothing
  Set value1 = Nothing
End Sub
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

chaelie2015
  • Résolu(e)
XL 2013 (RESOLU) Automatisation Copie Lignes Feuilles selon leurs nom
Réponses
10
Affichages
914
chaelie2015
chaelie2015
Lu76Fer
  • Résolu(e)
XL 2016 XLS - Comment déterminer les zones présentent au niveau d'une cellule ?
Réponses
2
Affichages
766
Lu76Fer
Lu76Fer
A
  • Résolu(e)
XL 2021 Calcule consommation de carburant
Réponses
3
Affichages
2 K
ayoub456
A
C
  • Résolu(e)
Microsoft 365 Mise en forme d'une ligne d'après listes déroulantes + clic sur un bouton
Réponses
2
Affichages
756
casualexcel
C
S
  • Question Question
XL 2019 Insérer une image en fonction de valeur cellule mais sur plusieurs lignes
Réponses
11
Affichages
4 K
job75
job75
B
  • Question Question
XL 2010 Nb.si.ens avec plusieurs critères
Réponses
7
Affichages
1 K
Banjounet
B
B
  • Question Question
XL 2013 [VBA] Extraction de données basé sur 2 à 3 conditions
Réponses
2
Affichages
2 K
bastienb
B
P
  • Question Question
XL 2013 calcul capacité charge équipe annuelle au jours le jours
Réponses
0
Affichages
9 K
PEX
P
R
  • Question Question
XL 2010 "RESOLU"VALEUR(S) MAX GESTION DES DOUBLONS
Réponses
3
Affichages
3 K
zebanx
zebanx
Sylvie
  • Question Question
Compilaton de plusieurs feuilles excel
Réponses
11
Affichages
1 K
Sylvie
Sylvie
cathodique
  • Question Question
Récupérer d'un tableau valeur sans doublon
2
Réponses
17
Affichages
4 K
cathodique
cathodique
Z
  • Question Question
Trouver la couleur d'une MFC et l'afficher dans la Cellule d'à coté !
Réponses
11
Affichages
3 K
zephir94
Z
M
  • Question Question
Encore recherchev ... question de newbie
Réponses
2
Affichages
788
Zdz16
Zdz16
M
  • Question Question
Calcul à la volée dans USF avec module de classe
Réponses
9
Affichages
1 K
mécano41
M
S
  • Question Question
Fonction MATCH() capricieuse (parfois marche, parfois bugge !)
Réponses
6
Affichages
1 K
Sebast
S
cathodique
  • Question Question
tableau de bord
Réponses
5
Affichages
2 K
cathodique
cathodique
O
  • Question Question
[RESOLU] Requêtage SQL dans feuille Excel
2
Réponses
26
Affichages
17 K
Orodreth
O
C
  • Question Question
collecter des données sur plusieurs feuille d'un autre classeur puis les recopier ?
2 3
Réponses
30
Affichages
27 K
Modeste
Modeste
O
  • Question Question
[RESOLU] Formules, intersection de lignes et de colonnes, compteurs
Réponses
2
Affichages
3 K
Orodreth
O
L
  • Question Question
Transfert de données
Réponses
0
Affichages
20 K
Lacure
L
Retour