Recopie ligne formules par vba et optimisation

KIM

XLDnaute Accro
Bonjour le forum.
J'utilise souvent la technique ci-dessous:
Je definis mes formules sur une ligne
et je la recopie par macro dans la plage souhaitée.
Ex:
mes formules en G2:M2 ,
la macro 'Copie_ligneformules_dansplage'
recopie et calcule chaque formule dans la plage G5:M208

Mes données reelles font presque 60 000 lignes et 50 colonnes. et le temps d'exécution est tres tres long.
Je souhaite optimiser ce code et le rendre plus rapide en utilisant les tableaux. Cela me fera gagner beaucoup de temps.
Merci de votre aide
Amicalement
KIM

Sub Copie_ligneformules_dansplage()
Dim w_nfile As String
Dim MyPath As String
Dim Ws As Worksheet
Dim n_line As Long


Set Ws = Worksheets('DATA2')

With Application
.ScreenUpdating = False
' .ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With

w_nfile = ActiveWorkbook.Name
MyPath = ActiveWorkbook.Path
Ws.Activate
Ws.Select
If Ws.AutoFilterMode Then
Selection.AutoFilter
End If

Windows(w_nfile).Activate
ActiveSheet.Calculate
n_line = Ws.Range('E2')

Range('G5:M' & n_line).Select
Selection.ClearContents


Range('G2:M2').Copy Destination:=Range('G5:G' & n_line)
ActiveSheet.Calculate
With Selection
.Copy
.Calculate
' .PasteSpecial Paste:=xlFormats
.PasteSpecial Paste:=xlValues
End With

With Application
.CutCopyMode = False
.DisplayAlerts = False
.ScreenUpdating = True
' .ScreenUpdating = False
.Calculation = xlCalculationManual
End With


MsgBox 'c'est fini'
End Sub [file name=prjKIMv1.zip size=35953]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/prjKIMv1.zip[/file]
 

Pièces jointes

  • prjKIMv1.zip
    35.1 KB · Affichages: 104

KIM

XLDnaute Accro
Re, Bebere, PierreJean,et le forum,

Je reviens vers vous car j'ai besoin de votre aide et celle du forum pour resoudre ce probleme et vous en remercie d'avance.

@Bebere je conserve ta macro et je vais l'utiliser dans ce contexte particulier. Mais ma demande est plus generale et concerne tout type de formules.

J'ai essayé d'introduire les tableaux dans mon code (voir macro recopie incrementee, bouton recopie formules V2).
- Je créé la liste unique de projets dans 'G5:G' & derlina
par recopie de la formule cellule G2 dans 'G5:G' & derlina
- Recap Depenses par projet et par departement:
par recopie de la ligne des formules sommeprod cellules H2:M2 dans la plage 'H5:M' & derling

1- Grande deception, aucun gain de temps par rapport à la V1.
2- Comment utiliser cette methode: recopie incrementée de ligne de formules dans une plage donnée en utilisant les tableaux d'une manière optimale
3- derling = ActiveSheet.Range('G65536').End(xlUp).Row
et derlina = ActiveSheet.Range('A65536').End(xlUp).Row
me donnent la meme valeur ce qui est anormal. Pourquoi?
Si quelqu'un peut m'aider? Merci d'avance.
Amicalement
KIM [file name=prjKIMv40.zip size=46058]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/prjKIMv40.zip[/file]
 

Pièces jointes

  • prjKIMv40.zip
    45 KB · Affichages: 91

pierrejean

XLDnaute Barbatruc
bonjour KIM

attention ta version 2 pollue la colonne G
teste la v1 avant et apres la v2 (temps x 4)
reesaie apres avoir tout supprimé en G apres la derniere valeur (+ 1 ligne)
je jete un oeil sur le probleme tel que tu le definis mais je ne te cache pas qu'il y a de fortes (mal)chances pour qu'il s'avere insoluble
 

Bebere

XLDnaute Barbatruc
bonjour Kim
extraction sans doublons et autofill
explication dans feuille
nettoyer fichier pour avoir - de 50k
à bientôt [file name=prjKIMv40_20060508110650.zip size=47871]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/prjKIMv40_20060508110650.zip[/file]
 

Pièces jointes

  • prjKIMv40_20060508110650.zip
    46.7 KB · Affichages: 96

KIM

XLDnaute Accro
Bonjour Bebere, PierreJean,et le forum,

Merci à vous tous d'avoir regardé mon probleme.
@PierreJean, La macro de Bebere repond bien à ma demande, mais j'ai un souci de format de données quand les codes sont des nombres et à l'origine le format est considéré comme du texte en standard.
@Bebere,
Je viens de tester ta nouvelle macro. Cela repond effectivement à mon probleme. Parcontre j'ai un souci en testant la macro:
1- Pour l'extraction des codes, tous les nombres sont considérés par defaut de type numerique. Le calcul des formules H5:M10 ne donnent que du '0'.
Comment modifier la recopie des codes avec le format d'origine.
2- Est-il possible de creer la ligne des Departement par extraction sans doublons des codes de la colonne A et recopie par transposition à partir de I4 et en H4 le titre Depenses Globales Cela me permet d'automatiser completement le tableau avec:
- Extraction sans doublons des codes dans G5:...
- Extraction sans doublons des Departements dans I4:... avec H4 titre fixe
- Copier H2:M2, Selection H5 et Autofill, copier, calculer et coller valeur
Merci d'avance pour ces modifs
Bien amicalement
KIM
 

ChTi160

XLDnaute Barbatruc
Salut KIM
bonjour Bebere
bonjour pierreJean
bon moi avec le fichier de Bebere,j'ai tenté de répondre à ton dernier message donc si j'ai bien compris:
tu as des formules en ligne 2 sur plus ou moins de colonnes,la macro prends(maintenant) en compte ce parametre en calculant la derniere colonne non vide de cette plage donc la plage de formules (H2 ':'(?)2) sera recopiée en Ligne 5 (? étant la derniere colonne non vide
Ensuite j'ai modifié pour que les chiffres soient assimilés à du texte(en colonne G) pour que les formules fonctionnent.
Ensuite la ligne des départements se remplie en fonction de la colonne Departement
Merci Bebere ,pierrejean
en espèrant avoir pu participer Lol [file name=KIMv41_09052006.zip size=42668]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/KIMv41_09052006.zip[/file]

Message édité par: Chti160, à: 09/05/2006 16:03
 

Pièces jointes

  • KIMv41_09052006.zip
    41.7 KB · Affichages: 30

Bebere

XLDnaute Barbatruc
bonjour Kim,Pierre-Jean,Chti
fait un peu la même chose que Chti
changé formules,pou dépenses globales et la somme
des chiffres sans code
trier sans doublons les codes dep
à bientôt [file name=prjKIMv41.zip size=48153]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/prjKIMv41.zip[/file]
 

Pièces jointes

  • prjKIMv41.zip
    47 KB · Affichages: 40

KIM

XLDnaute Accro
Bonjour Bebere,Pierre-Jean,et JeanMarie,
Merci pour votre derniere contribution,
J'ai utilisé un fichier test et tout est OK,
Je vais recuperer cette semaine un fichier de données réelles et tester la macro.
@Bebere,
De ma part j'essaye depuis ce matin de modifier les formules mais je heurtais sur des problemes de syntaxe vba.
Merci à vous, JeanMarie, Bebere et PierreJean
Grâce à cette manipulation de tableaux je vais gagner beaucoup de temps et j'espère passer de plus de 30 min d'execution à 5 min max pour 50 000 lignes et 25 colonnes.
Merci encore
Bien amicalement
KIM
 

KIM

XLDnaute Accro
Bonjour JeanMarie, Bebere,Pierre-Jean et le forum,
Je reviens vers vous pour essayer d'optimiser la macro Copyauto.
En effet la macro copyauto élaborée par Bebere et modifée par JeanMarie me fait gagner beaucoup de temps par rapport à ma macro initiale. la partie extraction sans doublons des projets (en colonne) et des Départements (en ligne) se fait en memoire via des tableaux.Beaucoup de gain d'execution.

Parcontre l'autofill, derniere partie de la macro (voir ci-dessous) se fait, si j'ai bien compris, par recopie des formules de la ligne source H2:O2 dans la plage cible, execute les formules et fait une recopie des valeurs dans les cellules.
------------
NbreL = .Range('G65536').End(xlUp).Row + 1
.Range(.Cells(2, , .Cells(2, .Cells(2, 255).End(xlToLeft).Column)).Copy
Sheets('data2').Range('H5').Select
Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Set maplage = .Range(.Cells(5, , .Cells(.Cells(65536, 7).End(xlUp).Row + 1, .Cells(4, 255).End(xlToLeft).Column))
Selection.AutoFill Destination:=maplage, Type:=xlFillDefault
With maplage '.Range('H5:M' & NbreL)
.Copy
.Calculate
.PasteSpecial Paste:=xlValues
End With
------------

Pour répondre à JeanMarie, Effectivement mes formules dans la ligne source sont compliquées et sont différentes d'un fichier à un autre mais la technique est toujours la meme et ma question est:
Est-il possible de:
a- déclarer la plage cible dans un tableau en memoire,
b- autofill, copy, calculate et Paste value dans le tableau en memoire,
c- vider le tableau dans la plage cible.
Est-ce possible et si Oui comment?
Merci,

Bien amicalement
KIM [file name=KIMv42.zip size=42146]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/KIMv42.zip[/file]
 

Pièces jointes

  • KIMv42.zip
    41.2 KB · Affichages: 30

ChTi160

XLDnaute Barbatruc
Salut KIM
Bonsoir le fil
Bonsoir le Forum

Arfff c que tu demande me semble difficile à réaliser (Hervé s'était lui aussi il y a quelques temps posé la question) mais pas de réponses favorables
on peut appliquer des formules à un tableau ex
- Compter le nombre d'éléments non vides dans un tableau :
Résult = WorksheetFunction.CountA (MonTableau)
Compter le nombre d'éléments vides (Empty) dans un tableau :
Résult = Ubound (montableau) - LBound(montableau) + 1 _
- WorksheetFunction.CountA(montableau)
ex Match etc
il y a aussi Evaluate qui pourrait permettre des calculs mais Bon ????
La fonction Evaluate
La fonction Evaluate de l'objet Application permet d'évaluer le résultat d'une expression passée sous la forme d'une chaîne de caractères, comme si cette expression était utilisée dans une formule de la feuille de calcul active. Par exemple, Evaluate ('SUM(A1:B10)/C12') renvoie le même résultat que la formule =SOMME(A1:B10)/C12 saisie à un endroit quelconque de la feuille de calcul active (avec, là aussi, les fonctions libellées en Anglais).
bon je te laisse,moi je cherche,mais bon Lol
Bonne fin de Soirée
 

Bebere

XLDnaute Barbatruc
bonsoir Kim,Jean marie
j'expérimente avec evaluate

Tablo(I, 1)contient le code(51,61..)
j'ai un résultat tant que code est numérique
après erreur,comment écrire la formule pour qu'elle fonctionne avec nombre et texte
j'ai créé par vba colb(sommes) et cold(codes)
parce que cde et code(dimensionner avec fonction décaler insertion nom définir)ne va pas
Tablo(I, 2) = Evaluate('SUMPRODUCT((ColD=' & Tablo(I, 1) & ')*ColB)')

à bientôt
 

ChTi160

XLDnaute Barbatruc
Bonsoir le fil
Salut Bebere
bien j'espère que tu nous mettras un petit exemple de ce que tu auras réussi a faire lol
je ne comprends pas bien ta question
écrire la formule pour qu'elle fonctionne avec nombre et texte
Valeur=Tablo(I,1)
peut être avec un IIf (est Numeric (Valeur),résultat1,résultat2) .je ne vois pas pour l'instant ce que tu nous prépares
merci D'avance
 

Bebere

XLDnaute Barbatruc
rebonsoir
oui Jean marie voilà le code
tu reconnaitra une partie
Sub x()
Dim Debut As Date, NbreL As Integer
Dim Tablo As Variant, I As Integer
Dim ColData As Collection, NameAddress As String, SheetName As String

Debut = Time
With Application
.ScreenUpdating = False 'True
.Calculation = xlCalculationManual 'Automatic
End With

With Sheets('data2')

'code
Tablo = .Range('D5:D' & .Range('D65536').End(xlUp).Row)

.Range('G5:M' & .Range('G65536').End(xlUp).Row).ClearContents

Set ColData = New Collection 'une collection,c'est sans doublons

For I = LBound(Tablo, 1) To UBound(Tablo, 1)
On Error Resume Next
ColData.Add CStr(Tablo(I, 1)), CStr(Tablo(I, 1))
On Error GoTo 0
Next I
I = 1
For Each Item In ColData
I = I + 1
.Range('G' & I + 4) = Item
Next Item
Set ColData = Nothing

.Range('G5:G' & .Range('G65536').End(xlUp).Row + 1).Sort Key1:=.Range('G5'), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
'dep
.Range('A5:D' & .Range('G65536').End(xlUp).Row + 1).Sort Key1:=.Range('A5'), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom

Tablo = .Range('A5:A' & .Range('A65536').End(xlUp).Row)

Set ColData = New Collection 'une collection,c'est sans doublons

For I = LBound(Tablo, 1) To UBound(Tablo, 1)
On Error Resume Next
ColData.Add CStr(Tablo(I, 1)), CStr(Tablo(I, 1))
On Error GoTo 0
Next I
I = 9
For Each Item In ColData
.Cells(4, I) = Item
I = I + 1
Next Item

Set ColData = Nothing

L = .Range('A65536').End(xlUp).Row ' + 1
SheetName = '=' & .Name & '!'
NameAddress = .Range('B5:B' & L).Address
ActiveWorkbook.Names.Add Name:='ColB', RefersTo:=SheetName & NameAddress
NameAddress = .Range('D5:D' & L).Address
ActiveWorkbook.Names.Add Name:='ColD', RefersTo:=SheetName & NameAddress
Tablo = .Range('G5:O' & .Range('G65536').End(xlUp).Row + 1)
'SUMPRODUCT(CDE*(CODE=$G2));SOMMEPROD(CDE*(CODE=TEXTE($G2;0))
For I = LBound(Tablo, 1) To UBound(Tablo, 1)
'numérique ok,texte erreur
Tablo(I, 2) = Evaluate('SUMPRODUCT((ColD=' & Tablo(I, 1) & ')*ColB)')
Next I
End With

End Sub
à bientôt
 

KIM

XLDnaute Accro
Bonjour le fil,
Merci Bebere et JeanMarie de se pencher de nouveau sur ce probleme.
En effet quand on manipule des donnees de plus de 50 000 lignes et 40 colonnes, on cherche toujours le moyen d'optimiser le code. Pour la premiere partie du code Titres lignes et titres colonnes l'utilisation des tableaux en memoire a donné un gain impressionnant. J'espere grace à vous ou à un forumeur (et si @+Thierry passe par là merci d'avance) d'executer la derniere partie en memoire.
@Bebere, merci de m'expliquer ton code et surtout l'integration de la fonction SUMPRODUCT.
Je ne l'ai pas compris.
En attendant, d'avance mille mercis à vous tous
Bien amicalement
KIM
 

Bebere

XLDnaute Barbatruc
bonjour le fil

aminci le fichier
emploi de evaluate et sumproduct
tout se passe en mémoire
ce sont les '' qui m'ont ennuyés,il fallait les doubler

à bientôt [file name=prjKIMv42.zip size=40288]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/prjKIMv42.zip[/file]
 

Pièces jointes

  • prjKIMv42.zip
    39.3 KB · Affichages: 37

Discussions similaires

Réponses
7
Affichages
292

Statistiques des forums

Discussions
311 733
Messages
2 082 019
Membres
101 872
dernier inscrit
Colin T