Faire recherche avec 2 critères ?

  • Initiateur de la discussion anthonygg
  • Date de début
A

anthonygg

Guest
Bonjour,

J'ai un premier onglet de saisie : je saisie la date, le numéro de machine et un commentaire.
J'aimerais que quand j'appui sur un bouton, un code VBA me fasse une recherche et place l'info au bon endroit dans mon tableau BDD. A la bonne date pour la bonne machine, donc faire une recherche avec deux critères.

Merci si un pro sait le faire

PS : Je sais le faire mais avec uniquement un critère

Voici mon fichier :
 

Pièces jointes

  • New Microsoft Excel Worksheet.xlsx
    9.1 KB · Affichages: 22
  • New Microsoft Excel Worksheet.xlsx
    9.1 KB · Affichages: 26
  • New Microsoft Excel Worksheet.xlsx
    9.1 KB · Affichages: 25

job75

XLDnaute Barbatruc
Re : Faire recherche avec 2 critères ?

Bonjour anthonygg, Lolote83,

Pas besoin de bouton :

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C2:C4]) Is Nothing _
  Or [C2] = "" Or [C3] = "" Then Exit Sub
Dim P As Range, t, x$, i&
Set P = Sheets("BDD").[B2].CurrentRegion
t = P 'matrice, plus rapide
x = [C2] & [C3]
For i = 2 To UBound(t)
  If x = t(i, 1) & t(i, 2) Then Exit For
Next
P(i, 1) = [C2]: P(i, 2) = [C3]: P(i, 3) = [C4]
'tri sur colonne C puis sur colonne B
P.Resize(P.Rows.Count + 1).Sort P(1, 2), 1, P(1), , 1, Header:=xlYes
End Sub
Fichier joint, notez la MFC pour les bordures du tableau.

A+
 

Pièces jointes

  • Transfert(1).xls
    43 KB · Affichages: 36
  • Transfert(1).xls
    43 KB · Affichages: 42
  • Transfert(1).xls
    43 KB · Affichages: 26
A

anthonygg

Guest
Re : Faire recherche avec 2 critères ?

Merci ! C'est bien ce que je veux.

Est possible maintenant de trouver le numéro de ligne dans le tableau BDD qui correspond à l'instersection de mes deux critères ? (Avec un bouton en plus et ça serait parfait de chez parfait)
 

job75

XLDnaute Barbatruc
Re : Faire recherche avec 2 critères ?

Re,

Avec ceci le repérage de la ligne se fait par le caractère de code 160 (espace insécable) :

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C2:C4]) Is Nothing _
  Or [C2] = "" Or [C3] = "" Then Exit Sub
Dim P As Range, t, x$, i&
Set P = Sheets("BDD").[B2].CurrentRegion
t = P 'matrice, plus rapide
x = [C2] & [C3]
For i = 2 To UBound(t)
  If x = t(i, 1) & t(i, 2) Then Exit For
Next
P(i, 1) = [C2]: P(i, 2) = [C3]: P(i, 3) = [C4] & Chr(160)
'tri sur colonne C puis sur colonne B
P.Resize(P.Rows.Count + 1).Sort P(1, 2), 1, P(1), , 1, Header:=xlYes
'repérage de la ligne
[C5] = Application.Match("*" & Chr(160), P(1, 3).EntireColumn, 0)
'effacement du caractère 160
P.Columns(3).Replace Chr(160), "", xlPart
End Sub
Fichier (2).

A+
 

Pièces jointes

  • Transfert(2).xls
    46 KB · Affichages: 26
  • Transfert(2).xls
    46 KB · Affichages: 38
  • Transfert(2).xls
    46 KB · Affichages: 38
Dernière édition:

Discussions similaires

Réponses
8
Affichages
861

Statistiques des forums

Discussions
311 712
Messages
2 081 802
Membres
101 819
dernier inscrit
lukumubarth