Trop de calculs tue le calcul...

K

kioups

XLDnaute Occasionnel
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
 
Trier par date Trier par votes
vbacrumble

vbacrumble

XLDnaute Accro
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
 
Vote positif 0 Vote négatif
K

kioups

XLDnaute Occasionnel
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...
 
Vote positif 0 Vote négatif
vbacrumble

vbacrumble

XLDnaute Accro
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
 
Vote positif 0 Vote négatif
vbacrumble

vbacrumble

XLDnaute Accro
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.
 
Vote positif 0 Vote négatif
K

kioups

XLDnaute Occasionnel
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
 
Vote positif 0 Vote négatif
soenda

soenda

XLDnaute Accro
Re : Trop de calculs tue le calcul...

Bonjour à tous, kioups

C'est bizarre, le classeur .xls est beaucoup plus gros que le classeur .xlsm
Cliquez pour agrandir...
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...
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif
vbacrumble

vbacrumble

XLDnaute Accro
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
 
Dernière édition:
Vote positif 0 Vote négatif
vbacrumble

vbacrumble

XLDnaute Accro
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)
 
Dernière édition:
Vote positif 0 Vote négatif
vbacrumble

vbacrumble

XLDnaute Accro
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
 
Vote positif 0 Vote négatif
K

kioups

XLDnaute Occasionnel
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.
 
Vote positif 0 Vote négatif
vbacrumble

vbacrumble

XLDnaute Accro
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 ?
 
Dernière édition:
Vote positif 0 Vote négatif
vbacrumble

vbacrumble

XLDnaute Accro
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
 
Dernière édition:
Vote positif 0 Vote négatif
K

kioups

XLDnaute Occasionnel
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.
 
Vote positif 0 Vote négatif

Discussions similaires

kercroam
  • Question
XL 2021 Modifier une condition pour le calcul du bonus défensif pour un programme de rugby
2 3
Réponses
32
Affichages
1 K
djidji59430
djidji59430
dn35
  • Résolu(e)
Microsoft 365 [RESOLU] format de cellule fonction liste déroulante (MFC trop lourde)
Réponses
8
Affichages
446
TooFatBoy
TooFatBoy
A
  • Question
Microsoft 365 Essai d'une création de macro
Réponses
8
Affichages
601
Dranreb
Dranreb
D
  • Question
Autres Un exemple de résultats pour un examen de secourisme
Réponses
7
Affichages
830
delta6x
D
Y
  • Question
XL 2019 Problème Calcul Tranches d'Âge et autres calculs Tableau de bord.
Réponses
0
Affichages
1 K
Yohan-L
Y
L
  • Question
créer une feuille de calcul des heures d'astreinte d'une équipe
Réponses
6
Affichages
3 K
lizlizliz
L
D
  • Question
Microsoft 365 Maj Tableau Croisé dynamique après calcul
Réponses
2
Affichages
950
dhaudhau
D
I
  • Question
Problème de lenteur de calcul avec une macro
Réponses
1
Affichages
868
INFINITY100
I
Arnaud-Denti
  • Question
Utilisation de Dictionary avec des fonctions de recherche perso
Réponses
8
Affichages
1 K
Dranreb
Dranreb
P
  • Question
Décroisage de matrice + fonctions (recherchev/equiv): calcul trop long
Réponses
8
Affichages
2 K
Promax
P

Membres actuellement en ligne

26 membres et 403 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 660
Messages
2 090 658
Membres
104 628
dernier inscrit
pival14