recherche VBA multi-colonnes

**kineton** · 04/01/2011, 12h00

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

**wilfried_42** · 04/01/2011, 12h09

bonjour

une formule peut t'interreser :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

=Index(C1:C20;Equiv(1;Sommeprod((A1:A20="1ercode")*(B1:B20="2emeCode"));faux))

**Philippe Tulliez** · 04/01/2011, 12h36

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

=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 :

Sélectionner tout - Visualiser dans une fenêtre à part

=INDEX($A$2:$G$50;SOMMEPROD((A2:A50="XXX")*(B2:B50="YYY")*(LIGNE(A2:A50)-1));6)

**kineton** · 04/01/2011, 13h31

Merci beaucoup, mais à priori je ne peut pas utiliser ces fonctions en VBA (ou alors il y a quelque chose qui m'échappe ?)

**Maxence HUBICHE** · 04/01/2011, 14h00

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

**kineton** · 04/01/2011, 15h06

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 ?

**casefayere** · 04/01/2011, 16h20

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**Philippe Tulliez** · 04/01/2011, 16h25

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**casefayere** · 04/01/2011, 16h54

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**Philippe Tulliez** · 04/01/2011, 16h57

Bonjour Casefayere,
J'avais effectivement vu et rectifié quelques minutes après.
Merci

**casefayere** · 04/01/2011, 17h06

et je préfère :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

a ton code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

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

**Maxence HUBICHE** · 05/01/2011, 01h11

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

Donc, je te propose quelque chose de ce genre

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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...

recherche VBA multi-colonnes [XL-2007]

Macros et VBA Excel

Discussions similaires

Partager

Partager