VBA: recherche de données selon plusieurs critères

Le 25/11/2013 à 14:46

Bonjour,

j'ai une feuille sur un document excel dans lequel on rentre des données.

En dessous de ces données, j'ai un tableau dans lequel j'aimerais qu'apparaisse toutes les références qui correspondent à tous les critères.

les critères:

A* la même famille

B* la même sous-famille

C* le stock (feuille 2) >= la quantité (feuille 1); le poids (feuille 2) >= le poids (feuille 2); le PCI (feuille 1) <=le PCI (feuille 2) <= le PCI (feuille 1)*1.12

D* le stock (feuille 2) >= la quantité (feuille 1)*2; le poids (feuille 1)/2<= le poids (feuille 2)< le poids (feuille 1); le PCI (feuille 1)/2 <= le PCI (feuille 2) <= [le PCI (feuille 1)/2]*1.12

j'aimerais ainsi que toutes les références qui correspondent à ses critères (A+B+C et A+B+D) se reportent dans le tableau de la feuille 1.

J'ai réalisé une macro avec des "If", mais ça me dit que dans ma boucle avec "For i", le "i" est une variable non définie.

Voici ma macro:

Option Explicit

Sub VALIDER()

Dim nbligne As Integer, nbligne2 As Integer, B As Integer
nbligne = WorksheetFunction.CountA(Range("A:A"))
nbligne2 = WorksheetFunction.CountA(Range("B30:B49"))
B = 2

Dim famille As String, sousfamille As String, PCI As Currency, poids As Currency, qté As Integer
famille = Sheets("Feuil2").Cells(10, 3)
sousfamille = Sheets("Feuil2").Cells(12, 3)
PCI = Sheets("Feuil2").Cells(8, 4)
poids = Sheets("Feuil2").Cells(7, 4)
qté = Sheets("Feuil2").Cells(5, 6)

'Dim ...
'...=...

Application.ScreenUpdating = False
Range("plage").ClearContents
Sheets("Feuil4").Select
For i = B To B + nbligne
  If Cells(i, 8) = famille Then
    If Cells(i, 9) = sousfamille Then
      If Cells(i, 5) >= PCI And Cells(i, 5) < (PCI * 1.12) Then
        If Cells(i, 3) >= poids Then
          If Cells(i, 7) >= qté Then
            Sheets("Feuil4").Cells(i, 1).Copy
            Sheets("Feuil2").Cells(30 + nbligne2, 2).PasteSpecial Paste:=xlPasteValues
          End If
        End If
      Else
        If Cells(i, 5) >= (PCI / 2) And Cells(i, 5) < ((PCI / 2) * 1.12) Then
          If Cells(i, 3) >= (poids / 2) And Cells(i, 3) < poids Then
            If Cells(i, 7) >= (qté * 2) Then
              Sheets("Feuil4").Cells(i, 1).Copy
              Sheets("Feuil2").Cells(30 + nbligne2, 2).PasteSpecial Paste:=xlPasteValues
            End If
          End If
        End If
      End If
    End If
  End If
Next i

End Sub

Pouvez-vous m'aider SVP???

Cordialement

67cindy32.xlsm (30.83 Ko)
Le 25/11/2013 à 15:24

bonjour,

sasn chercher à comprendre ton code, tu corriges l'erreur de variable non définie en la définissant 

dim i as long
Le 26/11/2013 à 11:06

Merci h2so4,

ça m'aide, mais mon code ne doit pas convenir pour ce que je veux faire je pense, parce que il n'y a qu'une seule référence qui apparaît, alors que j'aimerais que toute les références qui correspondent aux critères apparaissent.

est-ce qu'on peut m'aider, SVP???

Cdt

Le 26/11/2013 à 13:07

bonjour,

quelques corrections apportées à ton code, sans avoir essayé de comprendre ce que tu cherches à faire.

Option Explicit

Sub VALIDER()
Dim i As Long
Dim nbligne As Integer, nbligne2 As Integer, B As Integer
nbligne = Worksheets("Feuil4").Range("A" & Rows.Count).End(xlUp).Row
nbligne2 = WorksheetFunction.CountA(Worksheets("Feuil2").Range("B30:B49"))
B = 2

Dim famille As String, sousfamille As String, PCI As Currency, poids As Currency, qté As Integer
famille = Sheets("Feuil2").Cells(10, 3)
sousfamille = Sheets("Feuil2").Cells(12, 3)
PCI = Sheets("Feuil2").Cells(8, 4)
poids = Sheets("Feuil2").Cells(7, 4)
qté = Sheets("Feuil2").Cells(5, 6)

'Dim ...
'...=...

Application.ScreenUpdating = False
Range("plage").ClearContents
Sheets("Feuil4").Select
For i = B To B + nbligne
  If Cells(i, 8) = famille Then
    If Cells(i, 9) = sousfamille Then
      If Cells(i, 5) >= PCI And Cells(i, 5) < (PCI * 1.12) Then
        If Cells(i, 3) >= poids Then
          If Cells(i, 7) >= qté Then
            Sheets("Feuil4").Cells(i, 1).Copy
            Sheets("Feuil2").Cells(30 + nbligne2, 2).PasteSpecial Paste:=xlPasteValues
            nbligne2 = nbligne2 + 1
          End If
        End If
      Else
        If Cells(i, 5) >= (PCI / 2) And Cells(i, 5) < ((PCI / 2) * 1.12) Then
          If Cells(i, 3) >= (poids / 2) And Cells(i, 3) < poids Then
            If Cells(i, 7) >= (qté * 2) Then
              Sheets("Feuil4").Cells(i, 1).Copy
              Sheets("Feuil2").Cells(30 + nbligne2, 2).PasteSpecial Paste:=xlPasteValues
              nbligne2 = nbligne2 + 1
            End If
          End If
        End If
      End If
    End If
  End If
Next i

End Sub
Le 26/11/2013 à 14:54

Merci beaucoup, ça marche!!!

Et j'en profite pour te demander comment je peux faire pour que lorsque j'active ma macro, une fois mes données affichées, enlever la sélection sur la "feuil4"?

Cdt,

Le 26/11/2013 à 15:02

re-bonjour,

essaie ceci, à tester

Option Explicit

Sub VALIDER()
Dim i As Long
Dim nbligne As Integer, nbligne2 As Integer, B As Integer
nbligne = Worksheets("Feuil4").Range("A" & Rows.Count).End(xlUp).Row
nbligne2 = WorksheetFunction.CountA(Worksheets("Feuil2").Range("B30:B49"))
B = 2

Dim famille As String, sousfamille As String, PCI As Currency, poids As Currency, qté As Integer
famille = Sheets("Feuil2").Cells(10, 3)
sousfamille = Sheets("Feuil2").Cells(12, 3)
PCI = Sheets("Feuil2").Cells(8, 4)
poids = Sheets("Feuil2").Cells(7, 4)
qté = Sheets("Feuil2").Cells(5, 6)

'Dim ...
'...=...

Application.ScreenUpdating = False
Range("plage").ClearContents
With Sheets("Feuil4")
For i = B To B + nbligne
  If .Cells(i, 8) = famille Then
    If .Cells(i, 9) = sousfamille Then
      If .Cells(i, 5) >= PCI And .Cells(i, 5) < (PCI * 1.12) Then
        If .Cells(i, 3) >= poids Then
          If .Cells(i, 7) >= qté Then
            .Cells(i, 1).Copy
            Sheets("Feuil2").Cells(30 + nbligne2, 2).PasteSpecial Paste:=xlPasteValues
            nbligne2 = nbligne2 + 1
          End If
        End If
      Else
        If .Cells(i, 5) >= (PCI / 2) And .Cells(i, 5) < ((PCI / 2) * 1.12) Then
          If .Cells(i, 3) >= (poids / 2) And .Cells(i, 3) < poids Then
            If .Cells(i, 7) >= (qté * 2) Then
              .Cells(i, 1).Copy
              Sheets("Feuil2").Cells(30 + nbligne2, 2).PasteSpecial Paste:=xlPasteValues
              nbligne2 = nbligne2 + 1
            End If
          End If
        End If
      End If
    End If
  End If
Next i
End With
End Sub
Le 27/11/2013 à 09:05

Bonjour,

merci h2so4 pour ton aide.

j'ai essayé ce que tu m'as proposé et ça marche!

mais j'ai un autre petit soucis: quand je clique une deuxième sur le bouton pour activer ma macro, ça me met mes données dans mon tableau, mais j'ai des lignes vierges avant. si par exemple j'ai 2 lignes qui se remplissent, je vais avoir 2 lignes vides avant.

pourtant dans mon code j'ai mis que je souhaitais supprimer les données des cellules de B30 à B49 de la Feuil1, avant de commencer tous mes "If".

je pense que c'est tout bête, mais je ne vois pas comment résoudre le problème.

aurais-tu quelque chose à me proposer stp

Cdt,

Le 27/11/2013 à 13:09

bonjour,

pas de souci

voilà

Option Explicit

Sub VALIDER()
Dim i As Long
Dim nbligne As Integer, nbligne2 As Integer, B As Integer
nbligne = Worksheets("Feuil4").Range("A" & Rows.Count).End(xlUp).Row
'nbligne2 = WorksheetFunction.CountA(Worksheets("Feuil2").Range("B30:B49"))
nbligne2 = 0
B = 2

Dim famille As String, sousfamille As String, PCI As Currency, poids As Currency, qté As Integer
famille = Sheets("Feuil2").Cells(10, 3)
sousfamille = Sheets("Feuil2").Cells(12, 3)
PCI = Sheets("Feuil2").Cells(8, 4)
poids = Sheets("Feuil2").Cells(7, 4)
qté = Sheets("Feuil2").Cells(5, 6)

'Dim ...
'...=...

Application.ScreenUpdating = False
Range("plage").ClearContents
With Sheets("Feuil4")
For i = B To B + nbligne
  If .Cells(i, 8) = famille Then
    If .Cells(i, 9) = sousfamille Then
      If .Cells(i, 5) >= PCI And .Cells(i, 5) < (PCI * 1.12) Then
        If .Cells(i, 3) >= poids Then
          If .Cells(i, 7) >= qté Then
            .Cells(i, 1).Copy
            Sheets("Feuil2").Cells(30 + nbligne2, 2).PasteSpecial Paste:=xlPasteValues
            nbligne2 = nbligne2 + 1
          End If
        End If
      Else
        If .Cells(i, 5) >= (PCI / 2) And .Cells(i, 5) < ((PCI / 2) * 1.12) Then
          If .Cells(i, 3) >= (poids / 2) And .Cells(i, 3) < poids Then
            If .Cells(i, 7) >= (qté * 2) Then
              .Cells(i, 1).Copy
              Sheets("Feuil2").Cells(30 + nbligne2, 2).PasteSpecial Paste:=xlPasteValues
              nbligne2 = nbligne2 + 1
            End If
          End If
        End If
      End If
    End If
  End If
Next i
End With
End Sub
Le 27/11/2013 à 14:15

Merci beaucoup!

ça marche encore une fois!!

Je suis désolée d'encore t’embêter, je découvre les problèmes au fur-et-à-mesure!

j'ai un autre soucis qui m’embête bien.

je viens de tester (encore une fois) ma macro et espérais trouver, dans les données qui s'affiche dans le tableau, aussi bien les articles de même capacité, que ceux de capacité/2 (tout en gardant les critères de famille, sous-famille, PCI et qté).

Cependant, je n'ai que le produit de 70cl qui apparaît et pas celui de 35cl.

Pourrais-tu y jeter un oeil stp.

je remets mon document avec toutes les modifications.

Cdt

79cindy32-v2.xlsm (33.48 Ko)
Le 27/11/2013 à 15:41

bonjour,

je vois que tu as rajouté des instructions cells (,). tu dois les faire précéder d'un point "." pour les faire dépendre de l'instruction with qui précéde et qui indique sur quelle feuille il faut prendre les cellules. en omettant le ., tu fais le test avec la feuille active (sui est celle sur laquelle se trouve ton bouton et cela ne fonctionne pas.

voici ton code corrigé.

Option Explicit

Sub VALIDER()

Dim nbligne As Integer, nbligne2 As Integer, B As Integer
nbligne = Worksheets("Feuil4").Range("A" & Rows.Count).End(xlUp).Row
nbligne2 = 0
B = 2

Dim famille As String, sousfamille As String, PCI As Currency, poids As Currency, qté As Integer
famille = Sheets("Feuil1").Cells(10, 3)
sousfamille = Sheets("Feuil1").Cells(12, 3)
PCI = Sheets("Feuil1").Cells(8, 4)
poids = Sheets("Feuil1").Cells(7, 4)
qté = Sheets("Feuil1").Cells(5, 6)

'Dim ...

Application.ScreenUpdating = False
Range("réf").ClearContents
With Sheets("Feuil4")
Dim i As Long
For i = B To nbligne
  If .Cells(i, 8) = famille Then
    If .Cells(i, 9) = sousfamille Then
      If .Cells(i, 5) >= PCI And .Cells(i, 5) < (PCI * 1.12) Then
        If .Cells(i, 3) >= poids Then
          If .Cells(i, 7) >= qté Then
            .Cells(i, 1).Copy
            Sheets("Feuil1").Cells(30 + nbligne2, 2).PasteSpecial Paste:=xlPasteValues
            nbligne2 = nbligne2 + 1
          End If
        End If
      Else
        If .Cells(i, 5) >= (PCI / 2) And .Cells(i, 5) < ((PCI / 2) * 1.12) Then
          If .Cells(i, 3) >= (poids / 2) And .Cells(i, 3) < poids Then
            If .Cells(i, 7) >= (qté * 2) Then
              .Cells(i, 1).Copy
              Sheets("Feuil1").Cells(30 + nbligne2, 2).PasteSpecial Paste:=xlPasteValues
              nbligne2 = nbligne2 + 1
            End If
          End If
        End If
      End If
    End If
  End If
Next i
End With
End Sub
Le 28/11/2013 à 14:09

Bonjour h2so4,

Vraiment merci beaucoup pour ton aide!!!!!!!!!!!!!!!!!

Maintenant j'ai un document qui marche bien! Espérons que tout continue bien!

Cdt

Rechercher des sujets similaires à "vba recherche donnees criteres"