Comment remplacer la Fonction INDEX + EQUIV par du VBA

Bonjour,

Tout d'abord je tiens à préciser que je ne m'y connais pas du tout en VBA. Je fais appel à votre aide car j'ai un tableau assez lourd qui met énormément de temps à calculer.

Je souhaiterais diminuer un maximum ce temps de calcul par du VBA qui remplacerais toutes les fonctions index équiv de chaque ligne de mon tableau.

Résumé du fonctionnement actuel:

Dans L'onglet "DATA", des données brutes avec différents sont exportes d'un autre logiciel.

Dans L'onglet "suivi", je saisie manuellement les dossier que je souhaite suivre et les données des colonnes B, C, D, E, F, G se remplissent automatiquement en allant cherche les valeurs dans l'onglet "DATA". Pour cela j'utilise la fonction INDEX+EQUIV. C'est cette fonction que je souhaite remplacer.

Je vous remercie d'avance pour votre aide

Bonsoir,

Ton propos :

Dans L'onglet "suivi", je saisie manuellement les dossier que je souhaite suivre

est en contradiction avec ton fichier !

En effet, tu indiques reprendre dans ton onglet "Tableau" (que tu rebaptises "suivi" ci-dessus, mais c'est secondaire ) certains dossiers seulement de "Data".

Or, ton fichier fait apparaître que tu les reprends tous !

Si ton objectif est de servir l'onglet Tableau dans les conditions que tu indiques, sans utiliser de formules, fournis un fichier prêt à traiter : dans Tableau, la colonne A servie par les dossiers à y rapatrier, et rien d'autre.

Cordialement.

Bonsoir,

Je te remercie de ta réponse.

Dans l'onglet suivi colonne A, je saisie bien les dossiers que je veux suivre (je suis d'accord avec toi, sur ce fichier j'ai mis toutes les lignes hors dans la réalité je n'aurais pas tout les dossiers de "DATA". Je viens de rectifié en mettant qu'une partie des dossiers)

Voici le fichier rectifié sans formules et avec les dossiers à rapporter dans l'onglet "Tableau"

Encore merci de votre aide.

Bonsoir marcel33, MFerrand

Au vu de la présentation de tes données :

Option Explicit
Sub test()
Dim a
    With Sheets("Data").Range("a1").CurrentRegion
        a = Application.Index(.Value, Evaluate("row(1:" & _
                       .Rows.Count & ")"), Array(1, 7, 2, 3, 4, 5, 6))
    End With
    With Sheets("Tableau").Range("a1")
        .Resize(UBound(a, 1), UBound(a, 2)).Value = a
    End With
End Sub

Mais bon, y'a peut-être quelque chose qui m'a échappé

klin89

Bonsoir Klin89,

Je te remercie de ta réponse mais j'ai du mal expliqué ce que je souhaité.

Ton code permet de servit l'onglet "tableau" avec l'intégralité des données qui sont dans data et non pas uniquement les dossier que j'aurais saisi manuellement dans la colonne A de l'onglet "tableau".

Merci à vous

Re,

Salut klin89 ! Sauf erreur tu transfères tout... ?

Marcel : une version à compléter...

Sub TabloSuivi()
    Dim ASuiv, Dos, DSuiv(), i&, s&, das$
    Dos = Worksheets("Data").Range("A1").CurrentRegion.Resize(, 7).Value
    ASuiv = Worksheets("Tableau").Range("A1").CurrentRegion.Offset(1).Resize(, 1).Value
    ReDim DSuiv(1 To UBound(ASuiv) - 1)
    s = 1: das = ASuiv(s, 1)
    For i = 2 To UBound(Dos)
        If Dos(i, 1) = das Then
            DSuiv(s) = WorksheetFunction.Index(Dos, i, 0)
            If s + 1 <= UBound(DSuiv) Then
                s = s + 1: das = ASuiv(s, 1)
            Else
                Exit For
            End If
        End If
    Next i
    With Worksheets("Tableau")
        .Range("B2").Resize(s, 7).Value = WorksheetFunction.Transpose(WorksheetFunction _
         .Transpose(DSuiv))
        .Range("B2").Resize(s).Value = .Range("H2").Resize(s).Value
        .Range("H2").Resize(s).ClearContents
    End With
End Sub

Elle fonctionne sur le fichier test, mais les compléments à apporter sont de 2 ordres :

1) Effacer les données de suivi antérieures, sauf ligne d'en-tête, avant que tu remplisses la colonne pour le nouveau suivi à opérer.

Le plus logique est une procédure d'effacement à exécuter avant de remplir la colonne, mais je souhaitais que tu confirmes selon ta façon de procéder...

2) Il convient que Data soit trié, de même pour la colonne Dossier de Tableau, dans le fichier ils le sont, mais par sécurité il est souhaitable d'assurer un tri en début de procédure avant de passer au transfert.

J'aurais pu anticiper... mais je commence un peu à fatiguer. Ce sera demain.

Cordialement.

Re marcel33

Une autre façon de procéder

Option Explicit
Sub test()
Dim a, pos, x, i As Long, rng As Range
    Set rng = Sheets("Tableau").Range("a1").CurrentRegion
    a = Sheets("Data").Range("a1").CurrentRegion.Value
    With rng
        For i = 2 To .Rows.Count
            pos = Application.Match(.Cells(i, 1).Value, Application.Index(a, 0, 1), 0)
            If Not IsError(pos) Then
                x = Application.Index(a, _
                                      Evaluate("row(" & pos & ":" & pos & ")"), _
                                      Array(7, 2, 3, 4, 5, 6))
                .Cells(i, 2).Resize(, UBound(x)).Value = x
            End If
        Next
    End With
End Sub

On peut remplacer cette instruction

x = Application.Index(a, Evaluate("row(" & pos & ":" & pos & ")"), Array(7, 2, 3, 4, 5, 6))

par celle-ci :

x = Application.Index(a, pos, Array(7, 2, 3, 4, 5, 6))

klin89

Pas de retour ? On laisse en l'état donc !

Bonjour,

Je suis actuellement en congés je n'ai pas pu regarder depuis mon smartphone. Je regarde à mon retour semaine prochaine et je reviendrais vers vous dès que possible.

Désolé pour l'attente. Encore merci beaucoup à vous pour votre aide.