Macro Recherche ligne d'après plusieurs critères

[gim40]

Bonjour à tous et à toutes

je me décide enfin à faire appel à vos compétences car je dois avouer que je nage. Je désire trouver un numéro de ligne d'après plusieurs critères.
Voici comment j'envisage la macro (ne soyez pas trop sévère je débute). J'ai donc un fichier en cours à partir duquel je lance ma macro et qui va chercher les infos dans un autre fichier.

Sub Importation2()
Dim i, BonneLigne, Largeur, Longueur, Vitesses,DernièreLigne As Integer
Dim CodeType, Epaisseur As Variant


Longueur = Range("D1").Value 'affectation de variable d'après mon fichier en cours'
Largeur = Range("E1").Value   'affectation de variable d'après mon fichier en cours'
Epaisseur = Range("F1").Value  'affectation de variable d'après mon fichier en cours'
CodeType = Range("G1").Value    'affectation de variable d'après mon fichier en cours'
BonneLigne = 0
Vitesses = 0
Workbooks.Open Filename:="C:\Users\Gim\Documents\Classeur2013.xlsm" 'pour ouvrir le fichier ou les données sont contenues sous forme de tableau dynamique'
DerniereLigne = Range("A65536").End(xlUp).Row 'détermine la derniere ligne du fichier qui évolue en permanence'

For i = 1 To DerniereLigne 'Parcours séquentiel du fichier de données'


'Partie que je ne sais pas faire car conditions multiples

'If Range("E" & i).Value = Epaisseur et
'If Range("G" & i).Value = Longueur et
'If Range("F" & i).Value = Largeur et
'If Range("D" & i).Value = CodeType et
'If Range("I" & i).Value >= Vitesses'Then (si toute les conditions sont remplies)
Vitesse = Range("I" & i).Value
BonneLigne = i 'permet de récuperer le numéro de ligne qui me permettra d'exploiter les données que je recherche'

Next i

ThisWorkbook.Worksheets("Feuil1").Range("E6").Value = BonneLigne
' ou aussi ThisWorkbook.Worksheets("Feuil1").Range("E6").Value = Range("F" & BonneLigne).Value'
ActiveWorkbook.Close ' pour fermer le fichier de données '
 

End Sub

J'espère que c'est compréhensible.
Merci

 

[Robert]

Re : Macro Recherche ligne d'après plusieurs critères

Bonjour Gim et bienvenu, bonjour el forum,

Attention à la déclaration de tes variables. Tu peux en mettre plusieurs sur la même ligne en les séparant par une virgule mais il te faut, chaque fois, en spécifier le type. Sinon c'est le type Variant par défaut...Essaie comme ça :

Sub Importation2()
Dim i As Integer, BonneLigne As Integer, DernièreLigne As Integer
Dim Largeur As Integer, Longueur As Integer, Vitesses As Integer
Dim CodeType, Epaisseur As Variant
Dim test As Boolean 'déclare la variable test

Longueur = Range("D1").Value 'affectation de variable d'après mon fichier en cours'
Largeur = Range("E1").Value   'affectation de variable d'après mon fichier en cours'
Epaisseur = Range("F1").Value  'affectation de variable d'après mon fichier en cours'
CodeType = Range("G1").Value    'affectation de variable d'après mon fichier en cours'
BonneLigne = 0
Vitesses = 0
Workbooks.Open Filename:="C:\Users\Gim\Documents\Classeur2013.xlsm" 'pour ouvrir le fichier ou les données sont contenues sous forme de tableau dynamique'
DerniereLigne = Sheets(Le_nom_de_l_onglet).Range("A65536").End(xlUp).Row 'détermine la derniere ligne du fichier qui évolue en permanence'

For i = 1 To DerniereLigne 'Parcours séquentiel du fichier de données'
    'Partie que je ne sais pas faire car conditions multiples
    If Range("E" & i).Value <> Epaisseur Then test = True
    If Range("G" & i).Value <> Longueur Then test = True
    If Range("F" & i).Value <> Largeur Then test = True
    If Range("D" & i).Value <> CodeType Then test = True
    If Range("I" & i).Value < Vitesses Then test = True
    If test = False Then
        Vitesse = Range("I" & i).Value
        BonneLigne = i 'permet de récuperer le numéro de ligne qui me permettra d'exploiter les données que je recherche'
    End If
    test = False
Next i

ThisWorkbook.Worksheets("Feuil1").Range("E6").Value = BonneLigne
' ou aussi ThisWorkbook.Worksheets("Feuil1").Range("E6").Value = Range("F" & BonneLigne).Value'
ActiveWorkbook.Close ' pour fermer le fichier de données '
End Sub

 

[gim40]

Re : Macro Recherche ligne d'après plusieurs critères

Merci Robert!!!!
Je pensais pas avoir de réponse aussi rapidement !!!

La macro s’exécute correctement mais elle me renvoie la valeur 0 sur BonneLigne alors qu'elle devrait normalement m'envoyer un numéro de ligne

 

[gim40]

Re : Macro Recherche ligne d'après plusieurs critères

Bon je vous joint les deux fichiers afin que vous compreniez mieux mon problème!!!

normalement le test devrait me renvoyer la ligne 29 et la valeur 58 de mon tableau mais il me renvoie systématiquement la dernière ligne du tableau ?????

test.xlsm = la feuille contenant la macro
testchut.xlsm = mon tableau de données.

 

[Robert]

Re : Macro Recherche ligne d'après plusieurs critères

Bonsoir Gim, bonsoir le forum,

Le problème Gim vient du fait que quand tu veux spécifier un cellule d'un autre classeur l'adresse ne suffit pas. Il faut dire : Nom_Classeur.Nom_Onglet.Adresse. Sinon VBA prend toujours par défaut le classeur actif et l'onglet actif... J'ai donc modifié ton code pour que ça fonctionne :

Sub Importation2()
Dim c1 As Workbook 'déclare la variable c1 (Classeur 1)
Dim c2 As Workbook 'déclare la variable c2 (Classeur 2)
Dim o1 As Object 'déclare la variable o1 (Onglet du classeur 1)
Dim o2 As Object 'déclare la variable o2 (Onglet du classeur 2)
Dim i As Integer, BonneLigne As Integer, DernièreLigne As Integer
Dim Largeur As Integer, Longueur As Integer, Vitesses As Integer
Dim CodeType As String, Epaisseur As Variant
Dim test As Boolean 'déclare la variable test

Set c1 = ThisWorkbook 'définit le classeur c1
Set o1 = c1.Sheets("Feuil1") 'définit l'onglet du classeur 1
Longueur = o1.Range("D1").Value 'affectation de variable d'après mon fichier en cours'
Largeur = o1.Range("E1").Value   'affectation de variable d'après mon fichier en cours'
Epaisseur = InputBox("Veuillez saisir l'épaisseur de votre panneau:", "Epaisseur du planning", Range("B1").Value)
If Epaisseur = "" Then Exit Sub Else Epaisseur = CInt(Epaisseur)
CodeType = InputBox("Veuillez saisir le type complet de panneau:", "Type panneaux", Range("C1").Value)
If CodeType = "" Then Exit Sub
Workbooks.Open Filename:="C:\Users\Gim\Documents\testchut.xlsx" 'pour ouvrir le fichier ou les données sont contenues sous forme de tableau dynamique'
Set c2 = Workbooks("testchut.xlsx") 'définit le classeur c2
Set o2 = c2.Sheets("Feuil1") 'définit l'onglet du classeur c2
DerniereLigne = o2.Range("A65536").End(xlUp).Row 'détermine la derniere ligne du fichier qui évolue en permanence'
For i = 6 To DerniereLigne 'Parcours séquentiel du fichier de données'
    'si une seule des valeurs est différente, la variable test devient vraie
    If o2.Range("D" & i).Value <> CodeType Then test = True
    If o2.Range("E" & i).Value <> Epaisseur Then test = True
    If o2.Range("F" & i).Value <> Largeur Then test = True
    If o2.Range("G" & i).Value <> Longueur Then test = True
    If o2.Range("I" & i).Value < Vitesses Then test = True
    If test = False Then 'condition : si test est faux (donc si toutes les valeur sont égales (ou >= pour I)
        Vitesses = o2.Range("I" & i).Value 'récupère la vitesse
        BonneLigne = i 'permet de récuperer le numéro de ligne qui me permettra d'exploiter les données que je recherche'
        Exit For 'sort de la boucle
    End If 'fin de la condition
    test = False 'réinitialise la variable test
Next i 'prochaine ligne de la boucle
o1.Range("E6").Value = BonneLigne 'place en E6 le numéro de ligne
o1.Range("F6").Value = Vitesses 'Range("I" & BonneLigne).Value'place en F6
c1.Close ' pour fermer le fichier de données '
End Sub

Comme tu peux le remarquer, j'ai supprimé les deux lignes :

BonneLigne = 0
Vitesses = 0

car une variable de type Integer est toujours nulle tant qu'elle n'a pas été définie.
Le problème est que tu dis que tu attends 29 - 58 mais en fait, les lignes 27, 28, 29 et 30 respectent toutes les 4 conditions ! Alors pourquoi la ligne 29 ? J'ai pensé que c'était parce qu'elle avait la vitesse la plus élevée.
Si c'est le cas, un nouveau code qui utilise le filtre automatique.
Le code :

Sub Importation3()
Dim c1 As Workbook 'déclare la variable c1 (Classeur 1)
Dim c2 As Workbook 'déclare la variable c2 (Classeur 2)
Dim o1 As Object 'déclare la variable o1 (Onglet du classeur 1)
Dim o2 As Object 'déclare la variable o2 (Onglet du classeur 2)
Dim i As Integer, BonneLigne As Integer, DernièreLigne As Integer
Dim Largeur As Integer, Longueur As Integer, Vitesses As Integer
Dim CodeType As String, Epaisseur As Variant
Dim test As Boolean 'déclare la variable test

Set c1 = ThisWorkbook 'définit le classeur c1
Set o1 = c1.Sheets("Feuil1") 'définit l'onglet du classeur 1
Longueur = o1.Range("D1").Value 'affectation de variable d'après mon fichier en cours'
Largeur = o1.Range("E1").Value   'affectation de variable d'après mon fichier en cours'
Epaisseur = InputBox("Veuillez saisir l'épaisseur de votre panneau:", "Epaisseur du planning", Range("B1").Value)
If Epaisseur = "" Then Exit Sub Else Epaisseur = CInt(Epaisseur)
CodeType = InputBox("Veuillez saisir le type complet de panneau:", "Type panneaux", Range("C1").Value)
If CodeType = "" Then Exit Sub
Workbooks.Open Filename:="C:\Users\Gim\Documents\testchut.xlsx" 'pour ouvrir le fichier ou les données sont contenues sous forme de tableau dynamique'
Set c2 = Workbooks("testchut.xlsx") 'définit le classeur c2
Set o2 = c2.Sheets("Feuil1") 'définit l'onglet du classeur c2
o2.Range("A1").AutoFilter 'active le filtre automatique
o2.Range("A1").AutoFilter field:=4, Criteria1:=CodeType 'filtre la colonne D avec "CodeType" comme critère
o2.Range("A1").AutoFilter field:=5, Criteria1:=Epaisseur 'filtre la colonne E avec "Epaisseur" comme critère
o2.Range("A1").AutoFilter field:=6, Criteria1:=Largeur 'filtre la colonne F avec "Largeur" comme critère
o2.Range("A1").AutoFilter field:=7, Criteria1:=Longueur 'filtre la colonne G avec "Longueur" comme critère
mx = Application.WorksheetFunction.Max(o2.Columns(9).SpecialCells(xlCellTypeVisible)) 'définit la vitesse maximum mx
o2.Range("A1").AutoFilter field:=9, Criteria1:=mx 'filtre la colonne I avec "mx" comme critère
'condition : si il n'y a que deux valeurs dans la colonne A
If Application.WorksheetFunction.CountA(o2.Columns(1).SpecialCells(xlCellTypeVisible)) = 2 Then
    'définit la BonneLigne
    BonneLigne = o2.Cells(Application.Rows.Count, 1).End(xlUp).Row
Else 'sinon
    MsgBox "plusieur données correspondent au critères !" 'message
    'colore en rouge toutes les cellules visible de la colonne 9 (=I)
    o2.Columns(9).SpecialCells(xlCellTypeVisible).Interior.ColorIndex = 3
    c2.Activate 'active le classeur c2
    o2.Select 'active l'onglet o2
    o2.Range("A1").AutoFilter 'désactive le filtre automatique
    Exit Sub 'sort de la procédure
End If 'fin de la condition
o2.Range("A1").AutoFilter 'désactive le filtre automatique
o1.Range("E6").Value = BonneLigne 'place en E6 le numéro de ligne
o1.Range("F6").Value = mx 'place en F6 la vitesse maximum mx
c1.Close ' pour fermer le fichier de données
End Sub

 

[gim40]

Re : Macro Recherche ligne d'après plusieurs critères

Merci Beaucoup Robert !!!!!
C'est énorme j'aurais jamais trouvé seul !!!

C'est exactement ce que je voulais.

@++++