Recopie ligne formules par vba et optimisation

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
 

Fichiers joints

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]
 

Fichiers joints

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]
 

Fichiers joints

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]
 

Fichiers joints

KIM

XLDnaute Accro
Bonjour le fil,
Merci Bebere,
je me lève juste pour quitter le bureau et je recois ton message. Curieux, je regarde ton fichier sans attendre le lendemain. Suite à ce premier test, les resultats ne sont pas les memes en les comparants à la premiere macro. Par ex pour les codes projets 51, 52, 62, 64 et 71, les depenses globales et par DEP sont à '0'. J'ai l'impression qu'il y a un probleme de format??
Qu'en penses-tu?
Sinon, j'ai regardé ta macro, mais je n'arrive pas à comprendre. As-tu le temspd e la commenter?
Merci d'avance.
Bien amicalement
KIM
 

Bebere

XLDnaute Barbatruc
bonsoir à toutes et tous
corrigé et mis commentaires
j'ai relu le message de Jean Marie,qui m'a mis sur le bon chemin,j'ai pas dit le droit chemin
à bientôt [file name=prjKIMv42_20060516204045.zip size=41718]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/prjKIMv42_20060516204045.zip[/file]
 

Fichiers joints

ChTi160

XLDnaute Barbatruc
Salut KIM
Bonsoir Bebere
Bebere je vois que tu n'as pas perdu ton temps Chapeau pour ce que tu as réalisé
je n'ai pas eu le temps encore de bien regarder le dernier fichier
mais je me suis permis de remplacer la recopie des données
'For L = 2 To UBound(Tablo, 1)
'For C = 2 To UBound(Tablo, 2)
'.Cells(L, C).Offset(3, 6).Value = Tablo(L, C)
'Next C
'Next L
par .Range('G4').Resize(UBound(Tablo, 1), UBound(Tablo, 2)) = Tablo
nouvelle accélération lol
si tu es,comme moi un Mordu et je n'en doute pas
je pense que tu réfléchi déjà a comment,est ce possible ,peut on simplifier cette procèdure et ainsi encore gagné du temps
mais attention car bientôt la macro va avoir afficher le résultat avant de l'avoir lancé Lol
Encore Bravo Bebere,je vais regarder tout ca
Merci

Message édité par: Chti160, à: 16/05/2006 21:02
 

ChTi160

XLDnaute Barbatruc
Arfff
j'arrive plus a allèger le fichier et pourtant y reste plus rien dedans Lol
donc je joins la macro de Bebere que j'ai un peu modifié testé avec 11200 lignes 79 colonnes
et c'est pas mal
seul problème j'ai perdu la derniere ligne, tu sait,celle où y avait la Flêche Lol
mais bon on devrait la retrouver juste pour le fun comme dirait notre Ami @+Thierry
Voila la macro
Sub x()
Dim Debut As Date, NbreL As Integer
Dim Tablo As Variant, I As Integer, C As Byte, DerCol As Byte
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 + 1)

DerCol = IIf(.Cells(4, 255).End(xlToLeft).Column < 7, 7, .Cells(4, 255).End(xlToLeft).Column)
.Range(.Cells(4, 7), .Cells(.Cells(65536, 7).End(xlUp).Row + 1, DerCol)).ClearContents

.Range('G4') = 'Projets'
.Range('H4') = 'Dépenses Globales'
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('A65536').End(xlUp).Row).Sort Key1:=.Range('A5'), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom

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

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
'ce qui est çi-dessus vient du code autofill
L = .Range('D65536').End(xlUp).Row ' + 1
'donne un nom aux plages de cellules
'ColA=DEP,ColB=code,ColD=les montants à sommer
'tu les retrouves dans insertion nom définir
SheetName = '=' & .Name & '!'
NameAddress = .Range('A5:A' & L).Address
ActiveWorkbook.Names.Add Name:='ColA', RefersTo:=SheetName & NameAddress

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

DerCol = IIf(.Cells(4, 255).End(xlToLeft).Column < 7, 7, .Cells(4, 255).End(xlToLeft).Column)
Tablo = .Range(.Cells(4, 7), .Cells(.Cells(65536, 7).End(xlUp).Row + 1, DerCol))

'Tablo = .Range('G4:O' & .Range('G65536').End(xlUp).Row + 1)

For I = 2 To UBound(Tablo, 1)
'Depenses Globales
If IsNumeric(Tablo(I, 1)) Then Tablo(I, 2) = _
Evaluate('SUM((Cold=' & Tablo(I, 1) & ')*Col'B')')
If Not IsNumeric(Tablo(I, 1)) Or IsEmpty(Tablo(I, 1)) Then _
Tablo(I, 2) = Evaluate('SUM((Cold=''' & Tablo(I, 1) & ''')*Col'B')')

'tout ce qui suit CODE PROJETS et DEP
For C = 3 To UBound(Tablo, 2)
If IsNumeric(Tablo(I, 1)) Then Tablo(I, C) = Evaluate('SUM((Cold=' & _
Tablo(I, 1) & ')*(ColA=''' & Tablo(1, C) & ''')*Col'B')')

If Not IsNumeric(Tablo(I, 1)) Or IsEmpty(Tablo(I, 1)) Then _
Tablo(I, C) = Evaluate('SUM((Cold=''' & _
Tablo(I, 1) & ''')*(ColA=''' & Tablo(1, C) & ''')*Col'B')')
Next
Next I

.Range('G4').Resize(UBound(Tablo, 1), UBound(Tablo, 2)) = Tablo

End With
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
MsgBox 'temps: ' & Format(Time - Debut, 'h:m: 's')
End Sub
Arff y a des parasites Lol ColD 'B' Oter le guillemets autour des lettres en Gras Bé et estce

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

ChTi160

XLDnaute Barbatruc
Salut KIM
Bonjour Bebere
Bonjour le Fil ,Le Forum
en pièce jointe le fichier Lol
il suffit d'ajouter des Departements et des Codes et des Sommes bien sur
Bonne journée [file name=prjKIMv44.zip size=35754]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/prjKIMv44.zip[/file]

Message édité par: Chti160, à: 17/05/2006 08:19
 

Fichiers joints

KIM

XLDnaute Accro
Bonjour Bebere, JeanMarie
Bonjour le fil, le forum,
Merci à vous tous,
@Bebere,je savais que j'aurais une reponse à ma demande grace à toi. merci encore.
@JeanMarie, merci aussi de ta collaboration.
Je vais regarder le fichier
l'adapter à mes données et vous tenir au courant.
Bien amicalement
KIM
 

Bebere

XLDnaute Barbatruc
bonjour Kim,Jean-Marie
merçi à tous deux pour les compliments
j'ai retrouvé la flèche elle pointait sur un panneau avec le texte 'suite au prochain numéro'
cela me va le travail en groupe ça apporte un plus
je vais tester le code amélioré(sans aucun doute) de Jean-Marie
à bientôt
 

KIM

XLDnaute Accro
Bonjour Bebere, JeanMarie
Bonjour le fil, le forum,
J'apprends grace à vous et vous en remercie.
En lisant le code, si j'ai bien compris, la macro remplit directement la plage cible sans passer par les formules definies dans la ligne 2 (H2:M2).
Dans le fichier exemple les formules sont simples, et la fonction Evaluate('SUM(... repond bien à cet exemple. Dans la cas de formules plus complexes y-a-t-il moyen de modifier le code en donnant à evaluate, lors du balayage de la plage cible tablo, les formules de la ligne 2 (H2:M2)? Ne hurler pas j'espère que je ne dis pas de betises.
Merci d'avance
KIM
 

Bebere

XLDnaute Barbatruc
bonsoir à toutes et tous
explication dans le fichier
à bientôt [file name=prjKIMv44_20060517212309.zip size=42202]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/prjKIMv44_20060517212309.zip[/file]
 

Fichiers joints

Discussions similaires


Haut Bas