Trop de calculs tue le calcul...

kioups · 13 Mai 2009

Bonsoir à tous !

J'ai un classeur avec beaucoup de fonctions personnalisés (dans plus de 20 000). Paraît-il que ça gagnerait du temps...

Le problème, c'est que dès que je rentre une donnée dans une cellule, même si elle n'est pas concernée par un calcul. Ca part pour des heures de calcul... J'exagère, 2 bonnes minutes...

J'ai ce problème sous 2007, je l'avais déjà avant...

J'essaie de rendre mon fichier à peu près propre avant de le mettre en lien...

Kioups

vbacrumble · 14 Mai 2009

Re : Trop de calculs tue le calcul...

Re

Il y beaucoup de Select et d'Activate dans ton code que tu peux éviter

Et par ailleurs il manque quelque chose ici

Code:

Public Function Bonus(Votes As Range)
Dim i As Integer
Bonus = 0
For i = 1 To 10
     If
End Function

kioups · 14 Mai 2009

Re : Trop de calculs tue le calcul...

Effectivement, j'étais en train de travailler sur la Fonction Bonus quand j'ai fait les fichiers zip.

Pour les Activate, tu dois parler de la procédure d'Importation. Tu sais, j'ai fait ça à la barbare en enregistrant une macro et en faisant un copier-coller... Je ne suis pas surpris que ça soit très lourd, mais je maîtrise pas assez pour y remédier...

Pour les Select, tu parles de la fonction Points ? C'est celle que le classeur utilise le plus. J'ai pensé que c'était préférable aux If Then Else...

vbacrumble · 14 Mai 2009

Re : Trop de calculs tue le calcul...

Re

En général , il est inutile de sélectionner ou activer

Un exemple:

Code:

Sub avecselect()
    Sheets("Feuil1").Select
    Range("A1").Select
    With Selection.Font
        .Name = "Arial"
        .FontStyle = "Normal"
        .Size = 14
        .ColorIndex = 3
    End With
    Selection.Interior.ColorIndex = 6
End Sub

Code:

Sub sansselect()
With Sheets("Feuil1").Range("A1")
    With .Font
        .Name = "Arial"
        .FontStyle = "Normal"
        .Size = 14
        .ColorIndex = 3
    End With
    .Interior.ColorIndex = 6
End With
End Sub

kioups · 15 Mai 2009

Re : Trop de calculs tue le calcul...

Merci VBA, je vais essayer d'adapter ça...

Enfin, ça n'est pas cette macro qui est la plus gourmande...

vbacrumble · 15 Mai 2009

Re : Trop de calculs tue le calcul...

Re kioups , bonsoir à tous les autres

En général, moins tu utilises Select ou Activate, plus tu accélères la vitesse d'exécution de ton code.

D'où ma suggestion et mon exemple précédents.

kioups · 15 Mai 2009

Re : Trop de calculs tue le calcul...

Ce qu'il y a, c'est que c'est présent uniquement dans la macro Importation (si je ne me trompe pas...) et cette macro n'est utilisée que de façon ponctuelle, contrairement aux diverses fonctions personnalisées

soenda · 15 Mai 2009

Re : Trop de calculs tue le calcul...

Bonjour à tous, kioups

C'est bizarre, le classeur .xls est beaucoup plus gros que le classeur .xlsm

Remplace l'extension .xlsm, par.zip, puis dézipes-le ...

...tu dois parler de la procédure d'Importation... mais je maîtrise pas assez pour y remédier...

Dans la Sub Importation_Journée, les lignes suivantes:

Code:

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

peuvent-être remplacées par une seule ligne:

Code:

    Selection.Borders.LineStyle = xlNone

Je regarderai le code ce WE...

A plus

vbacrumble · 15 Mai 2009

Re : Trop de calculs tue le calcul...

Re

Je dirais même plus
Juste cela suffira

Code:

Cells.Borders.LineStyle = xlNone

ou plutôt

Code:

ActiveSheet.UsedRange.Borders.LineStyle = xlNone

Tu peux aussi modifier ainsi

Code:

' Rajout des deux calculs
    Cells(4, 1).FormulaR1C1 = _
      "=VALUE(IF(RIGHT(LEFT(R[-1]C,14))=""e"",RIGHT(LEFT(R[-1]C,13)),RIGHT(LEFT(R[-1]C,14),2)))"
    Cells(7, 1).FormulaR1C1 = "=VALUE(LEFT(R[-1]C,2))"

voir même ne pas utiliser de formule ici

vbacrumble · 15 Mai 2009

Re : Trop de calculs tue le calcul...

Re

Pour reprendre ma dernière suggestion

Teste ce code:

Code:

sub test()
Dim s$, ss$
s = "Rencontre : 1ere journee"
ss = "Rencontre : 22ème journee"
MsgBox 1 * Left(Split(Split(s, ":")(1))(1), (IIf(Len(Split(Split(s, ":")(1))(1)) = 5, 2, 1)))
MsgBox 1 * Left(Split(Split(ss, ":")(1))(1), (IIf(Len(Split(Split(ss, ":")(1))(1)) = 5, 2, 1)))
end sub

Ainsi ici tu pourrais modifier ainsi

Code:

' Rajout des deux calculs
 s=Cells(3,1).Text
    NumeroJournee = 1 * Left(Split(Split(s, ":")(1))(1), (IIf(Len(Split(Split(s, ":")(1))(1)) = 5, 2, 1)))
    JoueursJournee = 1 * Left(Cells(6, 1).Text,2)

kioups · 15 Mai 2009

Re : Trop de calculs tue le calcul...

Merci soenda et vbacrumble !

Je dois vous avouer que je sature un petit peu niveau vba en ce moment, j'essaie de revoir ça demain ou dimanche !

vbacrumble · 15 Mai 2009

Re : Trop de calculs tue le calcul...

Re

Voici une version avec suppression des Select

Peux-tu confirmer ou infirmer que le résultat est le même
qu'avec Importation_Journée originale ?

PS: j'ai supprimé le fusionnage pour un gain de place

Code:

Sub Importation_Journée(Nom$)
Dim WBK As Workbook, ws As Worksheet
Dim NumeroJournee&, JoueursJournee&, NbreJoueursTotal&, ColonneJoueur&
Dim i%, j%, k%, NJ%, N1%, NN%, N2%
Dim NomJoueur$, s$

Set WBK = ThisWorkbook: Set ws = ActiveSheet
' Rajout des deux calculs
s = ws.Cells(3, 1).Text
NumeroJournee = 1 * Left(Split(Split(s, ":")(1))(1), (IIf(Len(Split(Split(s, ":")(1))(1)) = 5, 2, 1)))
JoueursJournee = 1 * Left(ws.Cells(6, 1).Text, 2)
' Suppression des bordures
ws.Cells.Borders.LineStyle = xlNone
' Sélection des matchs de la journée
ws.Range("B9:C18").Copy WBK.Sheets("Feuil1").Cells(6 + 18 * (NumeroJournee - 1), 2)
'jusqu'ici OK
'Sélection d'un joueur
For i = 1 To JoueursJournee
        NomJoueur = ws.Cells(8, 8 + 4 * (i - 1))
'    ' Savoir si le joueur existe déjà ou pas
NbreJoueursTotal = WBK.Worksheets("Feuil1").Range("B1").Value
       k = 1
        Do While k < NbreJoueursTotal + 1
            If WBK.Worksheets("Feuil1").Cells(4, 15 + 3 * (k - 1)).Value = NomJoueur Then
                ColonneJoueur = 15 + 3 * (k - 1)
                Exit Do
            Else
                k = k + 1
            End If
        Loop
'    ' Copie du nom du joueur
    If k = NbreJoueursTotal + 1 Then
    ColonneJoueur = 15 + 3 * NbreJoueursTotal
    ws.Cells(8, 8 + 4 * (i - 1)).Copy WBK.Sheets("Feuil1").Cells(4, ColonneJoueur)
' Fusionnage des cellules
' Copie des votes du joueur
ws.Range(Cells(9, 8 + 4 * (i - 1)), Cells(18, 9 + 4 * (i - 1))).Copy WBK.Sheets("Feuil1").Cells(6 + 18 * (NumeroJournee - 1), ColonneJoueur)
    Else
    ws.Range(Cells(9, 8 + 4 * (i - 1)), Cells(18, 9 + 4 * (i - 1))).Copy WBK.Sheets("Feuil1").Cells(6 + 18 * (NumeroJournee - 1), ColonneJoueur)
    End If
Next i
End Sub

kioups · 16 Mai 2009

Re : Trop de calculs tue le calcul...

Bonjour vbacrumble

Après quelques essais sur la version .xls et sur le version 2007, je te confirme que cela donne le même résultat.

Par contre, j'ai un souci avec ma version .xls. La case B1, qui doit calculer le nombre de joueurs, par la formule

Code:

=16372-NB.SI(4:4;"")

ne donne pas le bon résultat (soit 34 dans le cas général...) mais 16162...

Sinon, j'ai des calculs faux dans la colonne NbJoueurs et des calculs qui ne devraient pas être effectués dans la colonne NbVainqueurs.

vbacrumble · 16 Mai 2009

Re : Trop de calculs tue le calcul...

Bonjour

=NB.SI(4:4;"")

renvoie : 118. C'est le chiffre que tu veux obtenir ?

NBVAL(4:4) renvoie lui : 46

et donc =NBVAL(4:4)-12 renvoie bien :34

Autrement , le temps de la macro que j'ai modifié est-il plus rapide ?

vbacrumble · 16 Mai 2009

Re : Trop de calculs tue le calcul...

Re

Pour accélére tu peux aussi ajouter ici (lignes en bleu)

Code:

Sub Ouvrir_Fermer_classeur()
Dim Nom$, awbkn$
[COLOR="Blue"]Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False[/COLOR]
Nom = Application.GetOpenFilename()
    If Nom = "" Then
        MsgBox "Aucun Fichier Sélectionné", _
            vbOKOnly + vbCritical, _
            "Importation des votes non réalisée "
        Exit Sub
        Else
        Workbooks.Open Filename:=Nom
        awbkn = ActiveWorkbook.Name
        Importation_Journée (Nom)
        Workbooks(awbkn).Close False
    End If
[COLOR="Blue"]Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True[/COLOR]
End Sub

PS: j'ai remplacé ceci
noext = Split(Nom, "\")(UBound(Split(Nom, "\")))
par plus simple, je ne sais pas pourquoi je m'étais compliqué la tâche

kioups · 16 Mai 2009

Re : Trop de calculs tue le calcul...

Merci vbacrumble ! (je vais finir par faire un copier-coller...)

Ca fonctionne très bien.

Le temps de calcul pour l'importation est plus rapide avec le rajout des 4 dernières lignes.

Trop de calculs tue le calcul...

kioups

XLDnaute Occasionnel

vbacrumble

XLDnaute Accro

kioups

XLDnaute Occasionnel

vbacrumble

XLDnaute Accro

kioups

XLDnaute Occasionnel

vbacrumble

XLDnaute Accro

kioups

XLDnaute Occasionnel

soenda

XLDnaute Accro

vbacrumble

XLDnaute Accro

vbacrumble

XLDnaute Accro

kioups

XLDnaute Occasionnel

vbacrumble

XLDnaute Accro

kioups

XLDnaute Occasionnel

vbacrumble

XLDnaute Accro

vbacrumble

XLDnaute Accro

kioups

XLDnaute Occasionnel

Discussions similaires

Trop de calculs tue le calcul...

XLDnaute Occasionnel

XLDnaute Accro

XLDnaute Occasionnel

XLDnaute Accro

XLDnaute Occasionnel

XLDnaute Accro

XLDnaute Occasionnel

XLDnaute Accro

XLDnaute Accro

XLDnaute Accro

XLDnaute Occasionnel

XLDnaute Accro

XLDnaute Occasionnel

XLDnaute Accro

XLDnaute Accro

XLDnaute Occasionnel

Discussions similaires

Privacy & Transparency

Privacy & Transparency