Lenteur de programme, idées d'optimisation ?

Bonjour,

J'ai une colonne sur la page1 avec un nombre de ligne variable contenant des reference :

xxxx
xxxx
xxxx
xxxx

En page 2, j'ai des réferences disposées en plusieurs colonnes (25) et un millier de lignes...

xxxx xxxx .... xxxx xxxx
xxxx xxxx ..... xxxx xxxx
.
.
.
xxxx xxxx ......xxxx xxxx

Le but est de comparer chaque référence en page 1 à toutes celles de la page deux afin de savoir si elle existe en page 2. Si c'est le cas, je releve le numero de ligne de la reference de page 2 et je vais recupérer sur cette même ligne un nombre que je vais ensuite copier dans une cellule en page 1 et bien sur à la ligne correspondant à la reference de la page 1.

Pour le moment j'ai crée un tableau à une dimension et un second à deux dimensions. Je compare et j'essaye de faire fonctionner le porgramme.
Sauf que vous comprenez, le pc galere car ça fait des millions de cas possible.

avez-vous une idée sachant que disons que sur la page 1 je peux avoir max 1000 réf, et en page 2, 1000 lignes et 25 colonnes de ref ...

Bonne soirée à tous et à toutes ;)

5 réponses

  1. Merci à tous pour vos réponses.

    J'ai finalement trouvé hier soir une solution et j'ai reussi à la faire fonctionner.

    Bonne journée
    1. Contributeur
      Le principe des forums est la mutualisation bénévole des connaissances, ce que plusieurs personnes ici ont tentés de faire pour t'aider

      donc
      si tu nous disais ce que tu as trouvé ? :-(
    2. Pardon ;)

      Alors j'ai continué sur mon idée de tableau pour pas perdre du temps.

      Ensuite j'ai ajouté un code que j'ai pu trouver, modifié à ma sauce.

      Le problème etait qu'avant je ne passais pas par "l".
      Bizarrement juste en ajoutant l = tab1(i - iSR1), j'ai tout débloqué :D
      Mon erreur etait de faire If tab3(j - 1, k - 3) = tab1(i-iSR1)

      iSR1 = 9
      iFR1 = Worksheets("Results").Cells(65535, 1).End(xlUp).Row 'connaitre la ligne ou s'arrete les numero de ref des geo en page 1

      iSR2 = 1
      iFR2 = Worksheets("DataPointages").Cells(65535, 1).End(xlUp).Row

      For i = iSR1 To iFR1

      l = tab1(i - iSR1)

      For j = iSR2 To iFR2
      For k = 3 To 28
      If tab3(j - 1, k - 3) = l Then
      wbk1.Worksheets("Results").Cells(i, 13).Value = wbk1.Worksheets("Results").Cells(i, 13).Value + (wbk1.Worksheets("DataPointages").Cells(j, 30).Value * TH)

      End If

      Next k

      Next j

      Next i
    3. Contributeur
      Ok, :o)
      mais si tu tu cherches à aller + vite utilises en début de macro ce thread

      application.screenupdating=False
      qui fige le défilement de l'écran
      contrairement à ce que l'on lit souvent, tu n'as pas besoin de le remettre à True en fin de macro puisque tu rends la main au système

      2/ dans la réalisation de tes tableaux , tu n'as pas besoin de boucler; par exemple:

      Tablo à1dimension=application.transpose(range(cells(1°ligne,"A"),cells(dernièreligne,"A")).value)
      Tablo
      à 2 dimensions=range(cells(1°ligne,"A"),cells(dernièreligne,"C")).value

      attention
      - value est obligatoire
      - tu es alors en variable-tableau de base 1 (Lbound est égal à 1 et non plus à 0)

      3/ je pense qu'il y a encore plus rapide avec un objet dictionary pour la feuille "result" mais il faudrait penser autrement et avoir des renseignements précis....
    4. application.screenupdating=False
      J'y ai pensé mais j'ai pas trouvé de différences alors du coup je l'ai retiré.

      2/ je ne vois pas trop ce que tu veux dire par là; désolé je suis pas non plus une brute en vba je fais au plus simple :p

      3/ Je vais me renseigner sur ça, je t'avoue ne pas connaitre mais plus rapide je suis, mieux c'est ^^

      En tous cas merci pour ton aide :)
    5. le screenupdate ne suffit pas toujours, il faut aussi enlever le calcul automatique. quite a le remettre à la fin.
      le plus correct est en début de macro, memoriser l'état dans lequel se trouve le calcul (automatique, manuel, sur ordre ....)
      et le remettre tel que tu l'as trouver à la fin de ta macro juste avant le "end sub"
  2. Contributeur
    Bonjour,

    Le mieux serait que tu joignes un extrait de ton classeur (200 lignes environ)

    pour joindre une pièce
    mettre le classeur sans données confidentielles en pièce jointe sur
    https://www.cjoint.com/
    puis copier l'adresse du lien et la coller dans le message de réponse


    qu'entends tu par
    allé recuperer une valeure quelque colonne plus loin
    

    quelque colonnes + loin ??? et que fait on avec plusieurs occurrences trouvées (cas de 5387, ligne 6 de ton exemple)???
    VBA demande à être précis :o)

    Dans l'attente

    Michel
    1. bonjour,

      hummm ... rechercher toutes les occurences, ajouter un nombre qui se trouve sur la même ligne ....

      Vous devriez chercher SommeProd...

      Je vais regarder votre code avec attention
      1. Bonjour,

        Merci de la réponse, mais le problème c'est qu'il peut y avoir des occurences, or la fonction rechercheV s'arrete des qu'elle a trouvé une fois.
        Voici un extrait de ma première page :

        5760 2 20 48 28 2 30000
        5618 3 35 70 44 3 0
        5617 3 35 35 30 3 4500
        5616 4 70 70 58 3 18000
        5578 2 35 35 29 1 4000
        5387 1 15 10 11 2 3000

        Et la 2ème :

        GEO-5357 5357
        GEO-4970-4972 4970 4972
        GEO-3790 3790
        GEO-4676 4676
        GEO-5388 5388
        GEO-4330-4331-4332-5387 4330 4331 4332 5387
        GEO-4393-4394 4393 4394

        Je dois détecter que "5387" est present en 4ème colonne allé recuperer une valeure quelque colonne plus loin et ensuite copier cette valeur et l'ajouter à 3000 en page 1 à la ref "5387" en dernière colonne

        Voici mon code, pas d'erreur généré mais seulement rien ne se passe.
        Le code ne rentre pas dans la denrière boucle et je crois que mes tableau ne se remplissent pas comme il faut :

        For i = 1 To 1000

        beta = Len(wbk1.Worksheets("DataPointages").Cells(i, 2).Value) - Len(Replace(wbk1.Worksheets("DataPointages").Cells(i, 2).Value, "-", ""))

        If beta = 1 Then

        wbk1.Worksheets("DataPointages").Cells(i, 3).Value = Mid(wbk1.Worksheets("DataPointages").Cells(i, 2).Value, 5)

        ElseIf beta > 1 Then

        For h = 1 To beta

        wbk1.Worksheets("DataPointages").Cells(i, 2 + h).Value = Split(wbk1.Worksheets("DataPointages").Cells(i, 2), "-")(h)

        Next h

        End If

        count = 0

        For j = 3 To 28

        If wbk1.Worksheets("DataPointages").Cells(i, j).Value <> "" Then

        count = count + 1

        End If

        Next j

        If wbk1.Worksheets("DataPointages").Cells(i, 1).Value <> "" Then

        wbk1.Worksheets("DataPointages").Cells(i, 29).Value = count

        End If

        If wbk1.Worksheets("DataPointages").Cells(i, 29).Value <> 0 Then

        wbk1.Worksheets("DataPointages").Cells(i, 30).Value = wbk1.Worksheets("DataPointages").Cells(i, 1).Value / wbk1.Worksheets("DataPointages").Cells(i, 29).Value

        End If

        ''''''TEST heure réelles''''''''

        If wbk1.Worksheets("Results").Cells(i + 8, 1).Value <> "" Then

        tab1(i - 1) = wbk1.Worksheets("Results").Cells(i + 8, 1).Value
        Debug.Print tab1(6)
        For p = 1 To 1000
        For j = 3 To 28

        tab2(p - 1, j - 3) = wbk1.Worksheets("DataPointages").Cells(p, j).Value

        If tab1(i - 1) = tab2(p - 1, j - 3) Then
        MsgBox ("plop")

        wbk1.Worksheets("Results").Cells(i + 8, 13).Value = wbk1.Worksheets("Results").Cells(i + 8, 13).Value + (wbk1.Worksheets("DataPointages").Cells(p, 30).Value * TH)

        End If

        Next j
        Next p

        End If
        Next i
        1. bonsoir,

          Regardes la fonction RechercheV(mot cherché;base;colonne de retour;faux)

          #N/A = Pas trouvé dans la première colonne de la base...