Rationaliser la constitution de mon fichier

Bernard34

XLDnaute Nouveau
Bonjour le forum,
Je vous lis depuis des semaines et grâce à vos questions et surtout à vos réponses j'ai beaucoup appris en peu de temps. Chaque jour ou presque je viens piocher des idées.

Je travaille sur un fichier comportant toujours les mêmes en-têtes en colonnes (de A4 à CC31000.
Le nombre de lignes varie chaque semaine.
Jusqu'alors, je recopie un premier fichier texte dans ma feuille Excel, puis avec la fonction recherche, je place les ingrédients dans les colonnes suivantes à l'aide d'une fonction recherchev. Et bien sûr cela fonctionne.

Ne sachant pas gérer le côté aléatoire du nombre de lignes, j'ai défini une longueur fixe à mon tableau. Sauf que bien sûr je me suis mis de la marge pour être sûr de n'oublier aucune potentielle ligne. Et que depuis plusieurs semaines, l'écart entre la réalité et la longueur de mon tableau porte sur près de 3 000 lignes. Toutes mes formules sont d'abord recopiées jusqu'à la ligne 31 000 et ensuite je recherche les #N/A pour les effacer. Ce qui occasionne un certain ralentissement.

A lire et relire, je constate qu'une boucle pourrait me faire gagner du temps.

Ce fichier est constitué chaque semaine à l'aide de VBA après la "récolte des ingrédients". La procédure "tourne" parfaitement, mais peut prendre jusqu'à plus d'une heure.

La procédure est exécutée sur 10 sites différents chaque semaine par des collègues qui trouvent toujours que c'est trop long.
Une fois constitué, le fichier est utilisé par près de 500 personnes.

J'ai remarqué que JP14 (je crois) réclamait un extrait de fichier chaque fois. Je ne peux le fournir, tout élément de ce fichier étant protégé par la CNIL.

Je n'arrive pas à comprendre comment à l'aide d'une boucle, je pourrai simplifier ma programmation.

Tout les fichiers avec lesquels je travaille sont au départ en format texte.
Je les traite, les organises.
Puis le fichier 1 est juste recopié sur une feuille Excel. 31 000 lignes, même si 5 000 sont vides.

Puis les fichiers suivants permettent d'alimenter les colonnes ne figurants pas dans le fichier1.

J'espère avoir été assez explicite et surtout pas trop long.

Et je tiens à repréciser que grâce à vous, j'ai appris depuis début décembre à automatiser tout ce que je faisais "à la main" chaque semaine depuis.... près d'un an.

Merci de vos conseils

Bernard
 

jp14

XLDnaute Barbatruc
Re : Rationaliser la constitution de mon fichier

Bonjour

Si j'ai bien compris tu pars d'un fichier texte qui comporte à priori une information qui permet de classer les données dans les colonnes, si cette information est un caractère (,; tabulation) au lieu d'utiliser des formules il faut utiliser l'option convertir du menu donnée, il en est de même si les champs ont une longueur fixe.

Pour développer une macro il faut les données pour établir le principe qui est traduit par le code, ou bien connaître l'algorithme ou logique du traitement.
JP
 
Dernière édition:

Bernard34

XLDnaute Nouveau
Re : Rationaliser la constitution de mon fichier

Bonsoir à tous,
Voici comment j'importe les données du fichier et comment je les mets en forme.

Workbooks.OpenText Filename:="trucmuche", Origin:=xlMSDOS, _
StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(18 _
, 1), Array(26, 1), Array(28, 1), Array(35, 1), Array(37, 1), Array(41, 1), Array(43, 1), _
Array(49, 1), Array(51, 1), Array(57, 1), Array(59, 1), Array(67, 1), Array(69, 1), Array( _
74, 1), Array(76, 1), Array(80, 1), Array(82, 1), Array(92, 1), Array(94, 1), Array(104, 1), _
Array(106, 1), Array(116, 1), Array(118, 1), Array(125, 1), Array(127, 1), Array(132, 1), _
Array(134, 1), Array(141, 1)), TrailingMinusNumbers:=True
Range("A:A,C:C,E:E,G:G,I:I,K:K,M:M,O:O").Select
Range("O1").Activate
ActiveWindow.SmallScroll ToRight:=7
Range("A:A,C:C,E:E,G:G,I:I,K:K,M:M,O:O,Q:Q,S:S,U:U").Select
Range("U1").Activate
ActiveWindow.SmallScroll ToRight:=7
Range("A:A,C:C,E:E,G:G,I:I,K:K,M:M,O:O,Q:Q,S:S,U:U,W:W,Y:Y,AA:AA").Select
Range("AA1").Activate
Selection.Delete Shift:=xlToLeft
Rows("1:18").Select
Range("A18").Activate
Selection.Delete Shift:=xlUp
Columns("B:N").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A6").Select
Windows("trucmuch 1").Activate
Range("BI4").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,Fichier2!R6C1:R31000C14,2)"
Range("BI5").Select
Selection.AutoFill Destination:=Range("BI5:BK5"), Type:=xlFillDefault
Range("BI5:BK5").Select
Range("BI4").Select
Selection.AutoFill Destination:=Range("BI4:BX4"), Type:=xlFillDefault
Range("BI4:BX4").Select
Range("BU4").Select
Selection.ClearContents
Range("BT4").Select
Selection.ClearContents
Range("BP4").Select
Selection.ClearContents
Range("BJ4").Select

Puis à partir d'ici, je lance les jointures entre le premier et le deuxième fichier (et je fais cela en tout 5 fois)

ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,Fichier2!R6C1:R31000C14,3)"
Range("BK4").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,Fichier2!R6C1:R31000C14,4)"
Range("BL4").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,Fichier2!R6C1:R31000C14,5)"
Range("BM4").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,Fichier2!R6C1:R31000C14,6)"
Range("BN4").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,Fichier2!R6C1:R31000C14,7)"
Range("BO4").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,Fichier2!R6C1:R31000C14,8)"
Range("BS4").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,Fichier2!R6C1:R31000C14,9)"
Range("BS4").Select
Selection.NumberFormat = "dd/mm/yy;@"
Range("BV4").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,Fichier2!R6C1:R31000C14,10)"
Range("BV4").Select
Selection.NumberFormat = "dd/mm/yy;@"
Range("BW4").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,Fichier2!R6C1:R31000C14,11)"
Range("BX4").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,Fichier2!R6C1:R31000C14,12)"
Range("BR4").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,Fichier2!R6C1:R31000C14,13)"
Range("BQ4").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,Fichier2!R6C1:R31000C14,14)"
Range("BQ5").Select
Application.Goto Reference:="R4C76:R31000C76"
Selection.FillDown
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.Goto Reference:="R4C75:R31000C75"
Application.CutCopyMode = False
Selection.FillDown
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.Goto Reference:="R4C74:R31000C74"
Application.CutCopyMode = False
Selection.FillDown
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.Goto Reference:="R4C71:R31000C71"
Application.CutCopyMode = False
Selection.FillDown
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.Goto Reference:="R4C70:R31000C70"
Application.CutCopyMode = False
Selection.FillDown
Application.Goto Reference:="R4C69:R31000C69"
Selection.FillDown
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("BR4").Select


et ensuite pour chaque zone concernée j'efface les valeurs inutiles du fait que les lignes étaient vides au départ.

Application.Goto Reference:="R4C34:R31000C34"
Application.CutCopyMode = False
Selection.FillDown
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Replace What:="#N/A", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

J'imagine qu'une routine pourrait rationaliser ces opérations, notamment en évitant toutes ces répétitions d'action.

Merci de votre intérêt.

Bernard
 

jp14

XLDnaute Barbatruc
Re : Rationaliser la constitution de mon fichier

Bonjour

Une piste :
Au lieu de remplir les cellules en utilisant une plage (Application.Goto Reference:="R4C75:R31000C75") fixe pourquoi ne pas rechercher la dernière cellule occupée
en utilisant des fonctions de ce type :
nomfeuille1 variable qui contient le nom de la feuille
dl1 = Sheets(nomfeuille1).Cells.SpecialCells(xlCellTypeLastCell).Row
dc1 = Sheets(nomfeuille1).Cells.SpecialCells(xlCellTypeLastCell).Column

dcel contient l'adresse de la dernière cellule identique à CTRL + Fin
dcel = Sheets(nomfeuille1).Cells.SpecialCells(xlCellTypeLastCell).Address(0, 0)

dcel2 = Sheets(nomfeuille1).Cells.SpecialCells(xlCellTypeLastCell).Address(ReferenceStyle:=xlR1C1

si on connait la colonne la dernière ligne est
dl1 = Sheets(nomfeuille1).Range("A65536").End(xlUp).Row


JP
 

Bernard34

XLDnaute Nouveau
Re : Rationaliser la constitution de mon fichier

Bonsoir à tous,

Depuis que JP m'a répondu, je cherche, je lis les questions et les réponses, j'avance doucement.

Néanmoins, je ne parviens à utiliser une variable pour définir une plage:

J'ai fait ceci:

' Identification de l'antenne concernée
derliA = Range("A65536").End(xlUp).Row
Range("AG2").Select
ActiveCell.FormulaR1C1 = _
"=+VLOOKUP(""Ale2"",'[Fichier .xls]Antennes'!R3C1:R15C3,3)"
Range("AG2:AG" & derliA).Select
Selection.FillDown
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Fin de l'identification de l'antenne concernée

'derliA = Range("A65536").End(xlUp).Row + 1
'derCol = Range("IV5").End(xlToLeft).Column
'Range("A2:AG" & derliA).Copy Range("A2:AG" & derliA)
'Range("A2:AG" & derliA).Copy Range("A2:AG" & derliA)
Application.Goto Reference:="R2C1:R5000C33"
Selection.Copy
Windows("Fichier rap.xls").Activate
[A65536].Select
Selection.End(xlUp)(2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
[A65536].Select
Selection.End(xlUp)(2).Select
Application.CutCopyMode = False

Il y a une apostrophe devant mes essais infructueux

Et je ne m'en sors pas.

si quelqu'un peut m'éclairer...

Merci
 

Pierrot93

XLDnaute Barbatruc
Re : Rationaliser la constitution de mon fichier

Bonjour Bernard, jp

regarde les codes commentés ci dessous pour utilisation d'une variable de type "range", si cela peut t'aider :

Code:
'déclaration de la variable
Dim maplage As Range
'initialisation de la variable
Set maplage = Range("A1:A25")
'utilisation de la variable, efface le contenu de la plage
maplage.ClearContents
'vide la variable (de type range)
Set maplage = Nothing

bonne journée
@+
 

Bernard34

XLDnaute Nouveau
Re : Rationaliser la constitution de mon fichier

Merci de vous intéresser à mon problème.
Ce que je n'arrive pas à faire c'est définir une plage qui va de A2 à AG derliA.
C'est à dire que j'arrive maintenant à stocker ma dernière ligne, mais je ne comprends pas comment écrire pour sélectionner de A2 à la dernière colonne utilisée (que je connais) et surtout la dernière ligne.

En fait je veux sélectionner, puis copier sur une autre feuille

'Range("A2:AG" & derliA).Copy Range("A2:AG" & derliA)
ceci ne fonctionne pas

Alors que ceci fonctionne
Application.Goto Reference:="R2C1:R5000C33"
mais j'ai beaucoup de lignes en trop

Merci de votre intérêt.

Bernard
 

Pierrot93

XLDnaute Barbatruc
Re : Rationaliser la constitution de mon fichier

Re

ta ligne de code est bonne, enfin si ta variable "derliA" est bien valorisée, par contre elle copie et colle au même endroit, même feuille et mêmes cellules, suis pas sur que ce soit le résultat attendu...

Code:
'en rouge la source, en bleu la destination 
[COLOR="Red"][B]Range("A2:AG" & derliA).[/B][/COLOR]Copy [COLOR="Blue"][B]Range("A2:AG" & derliA)[/B][/COLOR]

bon après midi
@+
 

Bernard34

XLDnaute Nouveau
Re : Rationaliser la constitution de mon fichier

Bonsoir le forum, JP et Pierrot,

Ca y est, gràce à vous j'ai réussi à identifier la dernière ligne de mon fichier, à la stocker dans une variable et à réduire sensiblement la taille de la programmation.

Voici ce que j'ai fait:

Dim derliA%
Windows("Fichier1").Activate
Range("C15:F" & derliA).Select
Application.CutCopyMode = False
Selection.Copy
Windows("Fichier2").Activate
Range("D4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Est-ce correct (cela fonctionne) et pourrait-on faire autement pour aller plus vite, sachant que je répète cette action sur un nombre important de colonnes.

Si vous avez des idées, je suis bien sûr preneur.

A bientôt et encore merci
bernard
 

Bernard34

XLDnaute Nouveau
Re : Rationaliser la constitution de mon fichier

Bonsoir à tous,

Je reviens à la charge avec mes problèmes.
De vous lire et relire m'apprend tellement de choses. Ainsi, avec SOMMEPROD que je ne connaissais pas, j'ai gagné 3 MO sur la taille du fichier. Ce qui n'est pas rien, car le fichier ne contenant que les macros pèse 22 Mo et après traitement il pèse 65 Mo!

Par contre INDEX EQUIV si chers à Monique, j'ai beau regarder les exemples, je n'arrive pas à maîtriser. Sur des opérations simples, c'est bon, mais dès que la formule se complique, je me noie!

J'ai cette formule dans la feuille que je parviens pas à mettre dans VBA.

Pouvez-vous m'aider, soit à la faire aller à la ligne, sans qu'elle soit interrompue, soit à la raccourcir ?

Merci de votre attention et de votre intérêt!

=SI(B46<>0;SOMMEPROD(('Dem'!$BH$4:$BH$65536=$B$6)*('Dem'!$B$4:$B$65536='Analyse A'!B46)*1)+SOMMEPROD(('Dem'!$BH$4:$BH$65536=$B$7)*('Dem'!$B$4:$B$65536='Analyse A'!B46)*1)+SOMMEPROD(('Dem'!$BH$4:$BH$65536=$B$8)*('Dem'!$B$4:$B$65536='Analyse A'!B46)*1)+SOMMEPROD(('Dem'!$BH$4:$BH$65536=$B$9)*('Dem'!$B$4:$B$65536='Analyse A'!B46)*1)+SOMMEPROD(('Dem'!$BH$4:$BH$65536=$B$10)*('Dem'!$B$4:$B$65536='Analyse A'!B46)*1)+SOMMEPROD(('Dem'!$BH$4:$BH$65536=$B$11)*('Dem'!$B$4:$B$65536='Analyse A'!B46)*1)+SOMMEPROD(('Dem'!$BH$4:$BH$65536=$B$12)*('Dem'!$B$4:$B$65536='Analyse A'!B46)*1)+SOMMEPROD(('Dem'!$BH$4:$BH$65536=$B$13)*('Dem'!$B$4:$B$65536='Analyse A'!B46)*1);"")


Sachant que dans la formule réelle, Dem comporte 17 caractères de plus (nom de l'onglet par trop explicite) et Analyse A est suivi de 5 caractères.
 

Discussions similaires

Statistiques des forums

Discussions
312 229
Messages
2 086 426
Membres
103 206
dernier inscrit
diambote