recherche VBA multi-colonnes

Version imprimable

04/01/2011, 12h00
kineton

recherche VBA multi-colonnes

Bonjour,

J'ai une feuille excel qui comporte 7 colonnes (COL_A à COL_G)

Les 2 premières colonnes me servent à identifier un enregistrement (= clef composée).

Je cherche à faire une recherche à l'aide de cette clef composée, donc sur mes 2 colonnes d'identification, c'est à dire à rechercher le ou les enregistrements qui remplissent les conditions COL_A = "xxx" et COL_B="yyy".

Je ne sais pas trop comment m'y prendre.

Quelqu'un a t il une idée ?

Merci
04/01/2011, 12h09
wilfried_42

bonjour

une formule peut t'interreser :

Code:

=Index(C1:C20;Equiv(1;Sommeprod((A1:A20="1ercode")*(B1:B20="2emeCode"));faux))
04/01/2011, 12h36
Philippe Tulliez

Bonjour,
Si XXX se trouve en colonne A et YYY en colonne B, ce code te donnera le n° de la ligne où ils se trouvent.

Code:

=SOMMEPROD((A2:A50="XXX")*(B2:B50="YYY")*(LIGNE(A2:A20)-1))

Donc pour obtenir une information contenue dans la colonne G (6ème colonne) d'un tableau référencé en A2:G50

Code:

=INDEX($A$2:$G$50;SOMMEPROD((A2:A50="XXX")*(B2:B50="YYY")*(LIGNE(A2:A50)-1));6)
04/01/2011, 13h31
kineton

Merci beaucoup, mais à priori je ne peut pas utiliser ces fonctions en VBA (ou alors il y a quelque chose qui m'échappe ?)
04/01/2011, 14h00
Maxence HUBICHE

Salut !

Tu veux en faire quoi ensuite ?
Récupérer le n° de la ligne ?
Récupérer toute la ligne ?
La mettre en surbrillance ?
...
Tu veux en faire quoi de ton truc ?
Parce que créer un algo pour trouver une ligne, c'est faisable, mais la finalité est utile aussi :s
04/01/2011, 15h06
kineton

Je vais essayer d'être complet sur mon problème.

Un fichier excel avec 2 feuilles.

Sur chaque feuille j'ai un tableau qui contient un certain nombre de lignes d'informations identifié chacune par une clef composée prénom-nom (colonnes B et C de ma feuille 1, et colonnes A et H de ma feuille 2).

Toutes les informations dont j'ai besoin se trouvent dans le tableau de ma feuille 1, sauf une (qui contient une adresse) se trouvant dans la colonne K de ma feuille 2.

Je cherche donc à mettre à jour le tableau de ma feuille 1 en y ajoutant dans la colonne H l'adresse récupérée sur la feuille 2.

Pour récupérer cette adresse et la copier dans la feuille 1, je souhaitais donc parcourir chaque ligne de ma feuille 1 pour récupérer le prénom et le nom, puis pour l'enregistrement correspondant à ce prénom-nom dans la feuille 2, récupérer l'adresse afin de la recopier dans la feuille1.

Est ce clair ?

Bonjour,
peut-être ce code qui risque d'être long à s'executer si tu as beaucoup de données

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub maj()
Dim nbl1 As Long, nbl2 As Long, x As Long, y As Long
Dim nompre As String
nbl1 = Sheets("feuil1").Range("B" & Sheets("feuil1").Rows.Count).End(xlUp).Row
nbl2 = Sheets("feuil2").Range("A" & Sheets("feuil2").Rows.Count).End(xlUp).Row
For x = 2 To nbl1
   For y = 2 To nbl2
      nompre = Sheets("feuil1").Range("B" & y) & Sheets("feuil1").Range("C" & y)
      With Sheets("feuil2")
         If nompre Like .Range("A" & x) & .Range("H" & x) Then
         ' si adresse a mettre en col "C"
            Sheets("feuil1").Range("D" & y) = .Range("K" & x)
         End If
      End With
   Next y
Next x
End Sub

si long passer par find
Bonne fin de journée

Bonjour,
Ce code suppose qu'il y a le même nombre de lignes dans les deux feuilles et qu'il n'y a pas de doublons

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Option Explicit
Sub MajFeuille()
  Dim DataFeuil1() As String, DataFeuil2() As String
  Dim i As Integer, r As Single
  Dim sht1 As Worksheet, sht2 As Worksheet
  Set sht1 = ThisWorkbook.Worksheets("Feuil1")
  Set sht2 = ThisWorkbook.Worksheets("Feuil2")
  Dim nbRec As Single
  nbRec = sht1.Range("B1").End(xlDown).Row
  ReDim DataFeuil1(nbRec), DataFeuil2(nbRec)
  For r = 2 To nbRec
   DataFeuil1(r) = sht1.Cells(r, 2) & sht1.Cells(r, 3) ' Colonne B & C de Feuil1
   DataFeuil2(r) = sht2.Cells(r, 1) & sht2.Cells(r, 8) ' Colonne A & H de Feuil2
  Next r
  For r = 2 To nbRec
   Debug.Print DataFeuil1(r) & "  =   " & DataFeuil2(r)
  Next r
  For r = 2 To nbRec
    For i = 1 To UBound(DataFeuil2)
     If DataFeuil1(r) = DataFeuil2(i) Then
      sht1.Cells(r, 8) = sht2.Cells(i, 11) ' Copie de colonne K (Feuil2) vers H (Feuil1)
     End If
    Next i
  Next r
End Sub

Bonjour corona,
Avec quelques corrections pour les colonnes incriminées :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub MajFeuille()
  Dim DataFeuil1() As String, DataFeuil2() As String
  Dim i As Integer, r As Single
  Dim sht1 As Worksheet, sht2 As Worksheet
  Set sht1 = ThisWorkbook.Worksheets("Feuil1")
  Set sht2 = ThisWorkbook.Worksheets("Feuil2")
  Dim nbRec As Single
  nbRec = sht1.Range("B1").End(xlDown).Row
  ReDim DataFeuil1(nbRec), DataFeuil2(nbRec)
  For r = 2 To nbRec
   DataFeuil1(r) = sht1.Cells(r, 2) & sht1.Cells(r, 3)
   DataFeuil2(r) = sht2.Cells(r, 1) & sht2.Cells(r, 8)
  Next r
  For r = 2 To nbRec
    For i = 1 To UBound(DataFeuil2)
     If DataFeuil1(r) = DataFeuil2(i) Then
      sht1.Cells(r, 4) = sht2.Cells(i, 11)   ' Recopie les données de la Colonne H des feuil1 & 2
     End If
    Next i
  Next r
End Sub

Bonne fin de journée

04/01/2011, 16h57
Philippe Tulliez

Bonjour Casefayere,
J'avais effectivement vu et rectifié quelques minutes après.
Merci
04/01/2011, 17h06
casefayere

et je préfère :

Code:

nbRec = sht1.Range("B" & sh1.rows.count).End(xlup).Row

a ton code :

Code:

nbRec = sht1.Range("B1").End(xlDown).Row

au cas où une cellule n'aurait pas de données

éhé !
Moi, je préfère éviter les boucles :)

Donc, je te propose quelque chose de ce genre

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
Option Explicit
Enum myCols
    myColNom1 = 2       'N° de la colonne pour le Nom dans la feuille 1                         (B=2)
    myColPrenom1 = 3    'N° de la colonne pour le Prénom dans la feuille 1                      (C=3)
    mycolrf1 = 52       'N° de la colonne pour le Prénom dans la feuille 1                      (AZ=52)
    mycolrr1 = 6        'N° de la colonne pour la récupération de l'adresse dans la feuille 1   (F=6)
    myStartRow1 = 2     'N° de la ligne de départ pour les calculs                              (2)
    myColNom2 = 1       'N° de la colonne pour le Nom dans la feuille 2                         (A=1)
    myColPrenom2 = 8    'N° de la colonne pour le Prénom dans la feuille 2                      (H=8)
    mycolrf2 = 52       'N° de la colonne pour le Prénom dans la feuille 2                      (AZ=52)
    mycolrr2 = 11       'N° de la colonne contenant les adresses sur la feuille 2               (k=11)
    myStartRow2 = 2     'N° de la ligne de départ pour les calculs                              (2)
End Enum
 
Sub FindAdresses()
    Dim oRF1                  As Range      'Plage pour la formule de clé
    Dim oRR1                  As Range      'Plage pour la formule de récupération des adresses
    Dim oRF2                  As Range      'Plage pour la formule de clé
    Dim oRR2                  As Range      'Plage pour les adresses d'origine
    Dim lRows                 As Long
    '## 1 ## Création de l'ID dans la feuille Feuil1
    '-- Définition du nombre de lignes
    lRows = Feuil1.UsedRange.Rows.Count
    '-- Définition de la plage pour la réception de la clé sur la feuille Feuil1
    With Feuil1
        Set oRF1 = .Range(.Cells(myStartRow1, mycolrf1), .Cells(lRows, mycolrf1))
    End With
    'Ecriture de la formule pour la clé
    oRF1.FormulaR1C1 = "=RC" & myColNom1 & "&""-""&RC" & myColPrenom1
    'et définition de la plage pour les adresses
    Set oRR1 = oRF1.Offset(0, mycolrr1 - mycolrf1)
    '## 2 ## Création de l'ID dans la feuille Feuil1
    '-- Définition du nombre de lignes
    lRows = Feuil2.UsedRange.Rows.Count
    '-- Définition de la plage pour la réception de la clé sur la feuille Feuil2
    With Feuil2
        Set oRF2 = .Range(.Cells(myStartRow2, mycolrf2), .Cells(lRows, mycolrf2))
    End With
    'Ecriture de la formule pour la clé
    oRF2.FormulaR1C1 = "=RC" & myColNom2 & "&""-""&RC" & myColPrenom2
    'et définition de la plage pour les adresses
    Set oRR2 = oRF2.Offset(0, mycolrr2 - mycolrf2)
 
    '## 3 ## Création de la formule pour la récupération de l'adresse, dans la feuille 1
    oRR1.FormulaR1C1 = "=INDEX(" & _
                        oRR2.Address(True, True, xlR1C1, True) & _
                        ",MATCH(RC[" & mycolrf1 - mycolrr1 & "]," & _
                        oRF2.Address(True, True, xlR1C1, True) & _
                        ",0))"
 
    '## 4 ## Suppression de la formule au profit de la valeur
    oRR1.Copy
    oRR1.PasteSpecial xlPasteValues
    Application.CutCopyMode = False
 
    '## 5 ## Suppression des formule de clé
    oRF1.ClearContents
    oRF2.ClearContents
End Sub

Je trouve que selon mes tests, c'est plutôt rapide... :)