VBA - Rechercher (deux types de recherches)

Bonjour,

Dans mon document Excel, je procède à des recherches pour générer des listes de correspondances. Je me suis rendu compte qu'avec la méthode que j'utilisais, mon document réalisait clairement plus de calculs que nécessaire.

En réalisant des recherches plus ciblées, mon ordinateur peut traiter les requêtes plus rapidement et c'est très bon à prendre compte tenu de la taille des bases de données.

Le problème, c'est que je ne sais pas comment rechercher plusieurs occurrences dans une plage de données.

Voici le code que j'utilise :

Dim i As Integer
Dim v As Variant, v2 As Variant, uniID As Variant
Dim OccuniID As Long
    For i = 2 To lrfb
        On Error Resume Next
        uniID = Application.WorksheetFunction.VLookup(n, Sheets("Formulaire bota").Range("D:R"), 15, 0)
        OccuniID = Application.WorksheetFunction.CountIf(sa.Range("A1:A" & lrsa), uniID)
        co.Range(Cells(2, 1), Cells(OccuniID, 1)) = IIf(IsError(uniID), 0, uniID)
    Next

Il va donc rechercher ma variable n (qui est renseignée dans une textbox (voir doc PJ)) ; dans la feuille 'Formulaire bota' colonne [D] et enregistre la correspondance qui se trouve en colonne [A] pour effectuer une recherche ensuite.

Sauf qu'ici, il y a deux correspondances, (il pourrait y en avoir 3, 4, 5, etc.) et je ne sais pas comment effectuer la recherche sur toutes les correspondances.

Peut-être mon approche n'est pas la bonne, aussi je vais plutôt détailler ce que je cherche à faire :

On saisit un numéro dans une Textbox présente dans un userform (qui s'ouvre à l'ouverture de la feuille)

Ce numéro doit être recherché dans la feuille 'Formulaire bota' colonne [D] et à chaque fois qu'il est trouvé, il doit récupérer l'information qui est présente dans la feuille 'Formulaire bota' colonne [A] (parentrowid)

On se sert ensuite des différents "parentrowid" enregistrés pour faire une recherche dans la feuille 'saisie' colonne [A] et on fait apparaître les correspondances des colonnes [D], [E] et [F] dans la feuille 'Correspondances' (à ce stade, peu importe les colonnes de destination).

Vous vous y prendriez comment ?

J'espère ne pas avoir été confus dans mes explications :/

Merci de votre attention.

Bonne journée !

Bonjour

Tu as 2016 donc PowerQuery Intégré.

Une proposition avec un tableau dans Correspondances permettant de sélectionner l'une des valeurs numero_eture de formulaire bota

La sélection d'une valeur déclenche (par une ligne de code Vba) la MAJ des requêtes PowerQuery qui croisent les lignes correspondantes de formulaire bota et Saisie et affiche les colonnes voulues dans Correspondances

La mise à jour de formulaire bota change l'état d'une variable qui déclenche aussi la MAJ des requêtes PowerQuery à l'activation de l'onglet Correspondances

Bonjour,

Merci pour votre aide, c'est exactement le résultat que je cherche à obtenir, cependant, mon document pourrait ne pas uniquement être utilisé par des ordinateurs ayant la version 2016 d'Excel, les tableaux "Formulaire bota" et "saisie" peuvent évoluer et sont importés depuis d'autres document Excel (ils ne sont pas censés être modifiés par l'utilisateur), l'UserForm qui s'active à l'ouverture de la feuille est là pour indiquer rapidement à l'utilisateur la procédure à suivre. Par la suite, d'autres calculs sont réalisés.

Dans ces conditions, je préfère éviter l'utilisation de PowerQuery. Surtout s'il y a des procédures particulières à suivre.

Merci encore pour la proposition que je serai en mesure d'utiliser sur des documents personnels plutôt.

Bon après-midi !

RE

Pas de procédure particulière à suivre : on pourrait remplacer le tableau de saisie par le userform mais il serait préférable d'y placer une liste déroulante des choix possibles pour éviter de gérer les erreurs de saisie comme je l'ai fait pour le tableau Choix.

PowerQuery est disponible en add on sur 2010 et 2013 mais effectivement si le parc est hétérogène...

Bonsoir,

Pour contourner mon problème, j'ai opté pour la suppression des lignes qui ne correspondent pas à la recherche.

Pour 3079 lignes, le traitement prend 11,50 secondes. Mais la suppression des lignes prends 9 secondes environ !

Voici le code (un peu long, au cas où quelqu'un en aurait besoin à un moment ; a priori il fonctionne avec le document test que j'ai joint au premier post) :

Option Explicit

Dim n As Long, Rep As Byte
Dim lrfb As Long, lrco As Long, lrsa As Long, r As Long
'Dim Lig As Long, NumLig As Long, NbrLig As Long, Col As String
Dim fb As Worksheet, sa As Worksheet, re As Worksheet, dc As Worksheet, ds As Worksheet, co As Worksheet
Dim rng As Range, Cell As Range, rng2 As Range, Cell2 As Range
Dim i&, derLn&, nb&
Dim del As Integer

Private Sub TextBox1_Change()

n = TextBox1.Value
'Pour vérifier la valeur de ma variable
'Range("A14") = n

End Sub

Private Sub CommandButton1_Click() 'KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
'If KeyCode = 13 Then CommandButton1_Click

Set fb = Worksheets("Formulaire bota")
Set sa = Worksheets("Saisie")
Set re = Worksheets("Regroupement")
Set co = Worksheets("Correspondances")

Dim Lig As Long
Dim Col As String
Dim NbrLig As Long
Dim NumLig As Long

co.Cells(1, 1).Value = sa.Cells(1, 1).Value
co.Cells(1, 2).Value = fb.Cells(1, 4).Value
co.Cells(1, 3).Value = sa.Cells(1, 4).Value
co.Cells(1, 4).Value = sa.Cells(1, 5).Value
co.Cells(1, 5).Value = sa.Cells(1, 6).Value
co.Cells(1, 6).Value = fb.Cells(1, 5).Value
co.Cells(1, 7).Value = fb.Cells(1, 6).Value
co.Cells(1, 8).Value = fb.Cells(1, 16).Value
co.Cells(1, 9).Value = fb.Cells(1, 17).Value
co.Cells(1, 10).Value = fb.Cells(1, 12).Value
co.Cells(1, 11).Value = fb.Cells(1, 13).Value

lrfb = fb.Cells(Rows.Count, 1).End(xlUp).Row
lrsa = sa.Cells(Rows.Count, 1).End(xlUp).Row

Dim vari As Range, plge As Range

'Vérifier si l'étude recherchée existe dans la bdd
    If Application.CountIf(fb.Range("D1:D" & lrfb), TextBox1.Value) = 0 Then
    MsgBox "L'étude recherchée n'existe pas"
    Exit Sub
    End If

'Remplissage de la colonne [A] (Parrent row ID) (lignes inactivées : colonne C especes)
     With sa
        'dernière ligne non vide de la colonne A
        lrsa = .Cells(.Rows.Count, 1).End(xlUp).Row
        'Plage à copier
        Set rng = .Cells(1, 1).Resize(lrsa + 1)
        Set rng2 = .Cells(1, 4).Resize(lrsa + 1)
    End With

    With co
        'dernière ligne non vide de la colonne A
        lrsa = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set Cell = .Cells(lrsa, 1)
        Set Cell2 = .Cells(lrsa, 3)
    End With

    rng.Copy Destination:=Cell
    rng2.Copy Destination:=Cell2

    With co
        'dernière ligne non vide de la colonne A
        lrsa = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        'plage de cellules
        Set rng = .Cells(1, 1).Resize(lrsa - 1)
        Set rng2 = .Cells(1, 3).Resize(lrsa - 1)
    End With

'Remplissage de la colonne [B] (Numéro étude)
Dim i1 As Integer, num1 As Variant
With Worksheets("Correspondances")
lrco = co.Cells(Rows.Count, 1).End(xlUp).Row
For i1 = 2 To lrco
On Error Resume Next
  num1 = Application.WorksheetFunction.VLookup(.Cells(i1, 1), Sheets("Formulaire bota").Range("A:D"), 4, 0)
  .Cells(i1, 2) = IIf(IsError(num1), 0, num1)
Next
End With

'Conserver les valeurs recherchées (num étude)
    With co
        For del = co.Range("B" & .Rows.Count).End(xlUp).Row To 2 Step -1
            If .Range("B" & del).Value <> n Then
            .Rows(del).Delete
            End If
        Next del
    End With

'Remplissage de la colonne [D] (abondance)
'Remplissage de la colonne [E] (remarque)
'Remplissage de la colonne [C] (especes) (désactivé)
Dim i2 As Integer, num2 As Variant, num3 As Variant, num4 As Variant
    With Worksheets("Correspondances")
        lrco = co.Cells(Rows.Count, 1).End(xlUp).Row
        For i2 = 2 To lrco
        On Error Resume Next
            num2 = Application.WorksheetFunction.VLookup(.Cells(i2, 1), Sheets("saisie").Range("A:E"), 5, 0)
            .Cells(i2, 4) = IIf(IsError(num2), 0, num2)
            num3 = Application.WorksheetFunction.VLookup(.Cells(i2, 1), Sheets("saisie").Range("A:F"), 6, 0)
            .Cells(i2, 5) = IIf(IsError(num3), 0, num3)
            'num4 = Application.WorksheetFunction.VLookup(.Cells(i2, 1), Sheets("saisie").Range("A:D"), 4, 0)
            '.Cells(i2, 3) = IIf(IsError(num4), 0, num4)
        Next
    End With

'Remplissage de la colonne [F] (cortege)
'Remplissage de la colonne [G] (autres_infos)
'Remplissage de la colonne [H] (x)
'Remplissage de la colonne [I] (y)
'Remplissage de la colonne [J] (created_date)
'Remplissage de la colonne [K] (created_user)
Dim num5 As Variant, num6 As Variant, num7 As Variant, num8 As Variant, num9 As Variant, num10 As Variant

    With Worksheets("Correspondances")
        For i2 = 2 To lrco
        co.Cells(i2, 10).NumberFormat = "dd/mm/yyyy;@"
        On Error Resume Next
            num5 = Application.WorksheetFunction.VLookup(.Cells(i2, 1), Sheets("Formulaire bota").Range("A:E"), 5, 0)
            .Cells(i2, 6) = IIf(IsError(num5), 0, num5)
            num6 = Application.WorksheetFunction.VLookup(.Cells(i2, 1), Sheets("Formulaire bota").Range("A:F"), 6, 0)
            .Cells(i2, 7) = IIf(IsError(num6), 0, num6)
            num7 = Application.WorksheetFunction.VLookup(.Cells(i2, 1), Sheets("Formulaire bota").Range("A:G"), 7, 0)
            .Cells(i2, 10) = IIf(IsError(num7), 0, num7)
            num8 = Application.WorksheetFunction.VLookup(.Cells(i2, 1), Sheets("Formulaire bota").Range("A:M"), 13, 0)
            .Cells(i2, 11) = IIf(IsError(num8), 0, num8)
            num9 = Application.WorksheetFunction.VLookup(.Cells(i2, 1), Sheets("Formulaire bota").Range("A:P"), 16, 0)
            .Cells(i2, 8) = IIf(IsError(num9), 0, num9)
            num10 = Application.WorksheetFunction.VLookup(.Cells(i2, 1), Sheets("Formulaire bota").Range("A:Q"), 17, 0)
            .Cells(i2, 9) = IIf(IsError(num10), 0, num10)
        Next
    End With

'Remplissage de la seconde colonne [B] (remarque)
Dim i As Integer, num As Variant
With Worksheets("Correspondances")
lrco = co.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lrco
On Error Resume Next

Next
End With
End sub

Bonne soirée !