Reduire temps de traitement

Le 13/10/2014 à 08:32

Bonjour à tous, toutes,

Ma grosse problématique, quelle piste pour reduire temps de traitement (cela mets actuellement plus de 24 heures..),et j'ai l'impression que la durée de traitement pour un jour donné augmente au fil des jours traités..

Dans le meme classeur, prise de donnees d'une feuille pour les reecrire dans une autre feuille en cumulant les données d'un jour.

Ex extrait données Feuille lue HISTO (3000 lignes)

28/02/2013 4,50 € 9,00 € 0

28/02/2013 -3,00 € 3,00 € 0

28/02/2013 -3,30 € 3,30 € 0

01/03/2013 -3,00 € 3,00 € 0

01/03/2013 18,00 € 9,00 € 0

01/03/2013 54,14 € 3,00 € 0

01/03/2013 -0,90 € 10,00 € 0

01/03/2013 -3,06 € 25,00 € 0

Feuille ecrite HIST :

28/02/2013 2 256,43 € -4,80 € 1 338,74 € 1,20 € 869,94 € -6,00 € 47,75 € 0,00 € 12,30 € 6,00 € 0 0,00 € 0,00 €

01/03/2013 2 321,61 € 65,18 € 1 355,84 € 17,10 € 921,08 € 51,14 € 44,69 € -3,06 € 19,00 € 6,00 € 25,00 € 0 0,00 € 0,00 €

Private Function ecrhist()
  Worksheets("HIST").Activate
  If rtot Then
  Cells.Clear
  Cells(1, 1) = "DATE"
  Cells(1, 2) = "Total Gains"
  Cells(1, 3) = "Jour"
  Cells(1, 4) = "Total SNG"
  Cells(1, 5) = "SNG"
  Cells(1, 6) = "Total MTT"
  Cells(1, 7) = "MTT"
  Cells(1, 8) = "Total CASH"
  Cells(1, 9) = "CASH"
  Cells(1, 10) = "BUY-IN SNG"
  Cells(1, 11) = "BUY-IN MTT"
  Cells(1, 12) = "CAVE ENTREE CASH"
  Cells(1, 13) = "FREEROLL"
  Cells(1, 14) = "EXP"
  Cells(1, 15) = "BUY-IN EXP"
  Cells(1, 16) = "Total EXP"
  indhist = 2
  sauvindhisto = 2
  Worksheets("HISTO").Activate
  sdate = Cells(2, 1)
  Else
     indhist = 2
     der = Range("A65536").End(xlUp).Row
     While Cells(indhist, 1) < xdate1 And indhist <= der
        indhist = indhist + 1
      Wend
      Range(Cells(indhist, 1), Cells(der, 16)).Select
      Selection.ClearContents
      Selection.ClearFormats
      sdate = xdate1
      Worksheets("HISTO").Activate
  End If
  derligne = Range("A65536").End(xlUp).Row
  gsng = 0
  gmtt = 0
  gcash = 0
  coutsng = 0
  coutmtt = 0
  coutcash = 0
  If rtot Then
   gtsng = 0
   gtmtt = 0
   gtcash = 0
   gtexp = 0
  Else
   Worksheets("HIST").Activate
   gtsng = Cells(indhist - 1, 4)
   gtmtt = Cells(indhist - 1, 6)
   gtcash = Cells(indhist - 1, 8)
   gtexp = Cells(indhist - 1, 16)
   Worksheets("HISTO").Activate
  End If
  gfree = 0
  gexp = 0
  coutexp = 0
  reinitecr = False
  For m = sauvindhisto To derligne
     If Cells(m, 1) = sdate Or IsDate(Cells(m, 1)) = False Then
       gsng = gsng + Cells(m, 2)
       gmtt = gmtt + Cells(m, 3)
       gcash = gcash + Cells(m, 4)
       gexp = gexp + Cells(m, 9)
       coutexp = coutexp + Cells(m, 10)
       coutsng = coutsng + Cells(m, 5)
       gfree = gfree + Cells(m, 8)
       coutmtt = coutmtt + Cells(m, 6)
       coutcash = coutcash + Cells(m, 7)
       If reinitecr = True Then
        reintecr = False
        gtsng = gtsng + gsng
        gtmtt = gtmtt + gmtt
        gtcash = gtcash + gcash
        gtexp = gtexp + gexp
       Else
        gtsng = gtsng + Cells(m, 2)
        gtmtt = gtmtt + Cells(m, 3)
        gtcash = gtcash + Cells(m, 4)
        gtexp = gtexp + Cells(m, 9)
       End If
     Else
       Call ecriturehist
       reintitecr = True
       indhist = indhist + 1
       gsng = Cells(m, 2)
       gmtt = Cells(m, 3)
       gcash = Cells(m, 4)
       gexp = Cells(m, 9)
       coutexp = Cells(m, 10)
       coutsng = Cells(m, 5)
       coutmtt = Cells(m, 6)
       gfree = Cells(m, 8)
       coutcash = Cells(m, 7)
       gtsng = gtsng + gsng
       gtmtt = gtmtt + gmtt
       gtcash = gtcash + gcash
       gtexp = gtexp + gexp
       sdate = Cells(m, 1)
     End If
     Call ecriturehist
  Next m
  Call mformhist
  Call figelignesup
  Call Gainjourdeb
  Application.ScreenUpdating = True
  Application.StatusBar = ""
  MsgBox ("FIN Recréation HIST")
  Call acueil
End Function
Sub ecriturehist()
 Sheets("HIST").Range("A" & indhist).Value = sdate
 Sheets("HIST").Range("E" & indhist).Value = gsng
 Sheets("HIST").Range("G" & indhist).Value = gmtt
 Sheets("HIST").Range("I" & indhist).Value = gcash
 Sheets("HIST").Range("D" & indhist).Value = gtsng
 Sheets("HIST").Range("F" & indhist).Value = gtmtt
 Sheets("HIST").Range("H" & indhist).Value = gtcash
 Sheets("HIST").Range("N" & indhist).Value = gexp
 Sheets("HIST").Range("P" & indhist).Value = gtexp
 If coutsng <> 0 Then
  Sheets("HIST").Range("J" & indhist).Value = coutsng
 End If
 If coutmtt <> 0 Then
  Sheets("HIST").Range("K" & indhist).Value = coutmtt
 End If
 If coutcash <> 0 Then
  Sheets("HIST").Range("L" & indhist).Value = coutcash
 End If
 If coutexp <> 0 Then
  Sheets("HIST").Range("O" & indhist).Value = coutexp
 End If
 Sheets("HIST").Range("M" & indhist).Value = gfree
 totgainjour = gsng + gmtt + gcash + gexp
 totbnk = gtsng + gtmtt + gtcash + gtexp + Sheets("RECAP").Range("K16").Value + Sheets("RECAP").Range("L16").Value
 Sheets("HIST").Range("C" & indhist).Value = totgainjour
 Sheets("HIST").Range("B" & indhist).Value = totbnk
End Sub
Le 13/10/2014 à 13:07

Bonjour

zorus21 a écrit :

cela mets actuellement plus de 24 heures..)

Énorme

Il faudrait voir ton fichier pour effectuer quelques tests

Le 15/10/2014 à 09:21

Bonjour,

J'ai trouve en parcourant ce forum, en fait la grosse perte de temps c'est les ecritures et lecture dans les cellules d'une feuille , tres tres gros gain de temps en definisant le range d'une feuille, en mettant ce range dans un variant et en travaillant sur ce variant, puis recopie du variant dans la feuille au finale.

Rechercher des sujets similaires à "reduire temps traitement"