VBA ou autres formules ! Calcul moyenne en fonction de, tant que

[justinev]

Bonjour à tous,

Je me casse les dents actuellement sur un projet excel, j'ai beaucoup appris en peu de temps mais là je coince.

Si vous avez plus d'idée que moi, je suis preneuse ! J'ai essayé "Moyenne.si", fonction "Si" imbriqué en nb.val mais sans succès.

Alors j'ai un fichier (ci-joint) comprenant une colonne "bon de livraison" et une colonne "coût de la livraison", les lignes correspondent aux produits.

Je souhaite calculer la moyenne pour chaque produit en fonction du coût de livraison. Sachant que les BL ne contiennent pas tous le même nombre de produit.

Donc tant que mon bon de livraison est égal à celui de la ligne en dessous compter le nombre de valeur et faire la moyenne en fonction du coût de livraison.

Je ne suis pas assez douée pour coder une boucle en vba.

En vous remerciant !

 

[justinev]

Re : VBA ou autres formules ! Calcul moyenne en fonction de, tant que

Bonjour,

Je viens de prendre le temps d'essayer la macro en l'adaptant à mon fichier. Mais le code beug à la condition en affichant l'erreur "13".

If tabl(h, LBound(tabl(), 2)) = tabl(i, LBound(tabl(), 2)) Then

tabl(i, UBound(tabl(), 2)) = tabl(i, UBound(tabl(), 2)) + tabl(h, UBound(tabl(), 2) - 1)
NbMoy = NbMoy + 1

End If

 

[justinev]

Re : VBA ou autres formules ! Calcul moyenne en fonction de, tant que

Bonjour !

J'ai adapté le code à mon fichier mais une erreur "13" s'affiche sur la condition.

For i = LBound(tabl()) To UBound(tabl())

For h = LBound(tabl()) To UBound(tabl())

If tabl(h, LBound(tabl(), 2)) = tabl(i, LBound(tabl(), 2)) Then

tabl(i, UBound(tabl(), 2)) = tabl(i, UBound(tabl(), 2)) + tabl(h, UBound(tabl(), 2) - 1)
NbMoy = NbMoy + 1

End If

 

[VDAVID]

Re : VBA ou autres formules ! Calcul moyenne en fonction de, tant que

Bonjour justinev,

Si le code plante à cet endroit, cela veut dire que les valeurs à additionner ne sont pas des nombres.
L'erreur peut provenir:

- Que la colonne du Poids des BL contient des valeurs textes
- Que la colonne n'a pas été correctement adapté dans les variables du début.

As tu bien adapté la variable sur cette ligne?

'Colonne où se trouve les poids totals par BL
ColM = "L"

 

[justinev]

Re : VBA ou autres formules ! Calcul moyenne en fonction de, tant que

Bonjour

J'ai essayé plusieurs choses :

- mettre en format "nombre" mes données - Toujours erreur sur la condition

- adapté les colonnes - ColL = "[A:A]" ----- ColM = "[M:M]" + Format "nombre" et une autre erreur apparait :

La méthode range de l'objet worksheet a échoué - Erreur d'exécution 1004

Et le débogueur m'amène à cette ligne du code :

With Ws

LFin = .Range(ColL & 65536).End(xlUp).Row

Je suis désolée mais le vba n'est pas du tout mon fort !

 

[VDAVID]

Re : VBA ou autres formules ! Calcul moyenne en fonction de, tant que

Bonjour justinev,

Pas de soucis, on va y arriver

Dans ton fichier final, dans quelle colonne se trouve le poids des BL et dans quelle colonne se trouve les livraisons ?

La synthaxe qu'il faut adopter pour ColL ou ColM est la ou les lettre(s) de la colonne.

 

[justinev]

Re : VBA ou autres formules ! Calcul moyenne en fonction de, tant que

J'espère ! Je comprend les bases et la logique par contre codé, c'est hors de mes capacités... C'est aussi pour cela que j'ai arreté mon DUT où le code et l’algorithme étaient trop présent à mon goût !

Dans mon fichier final, les livraisons = A ; le cout de la livraison = M. J'ai bien remplacé mes colonnes dans le code et modifier les formats pour chacune.

J'aimerais affiché les moyennes dans la colonne N, si possible afin de vérifier le fonctionnement. Mais je crois bien que Excel m'en veut, sur ce fichier je suis à plus de 4 pages de macro...

 

[VDAVID]

Re : VBA ou autres formules ! Calcul moyenne en fonction de, tant que

Re,

Haha mais non, excel est très gentil !

Du coup, il ne faut pas toucher à la variable ColL qui reste comme ceci:

ColL = "A"

Mais modifier la variable ColM qui passe de

ColM = "L"

à:

ColM = "M"

De plus, à quelle ligne démarre ton tableau ? (La première ligne comprenant des nombres dans ta colonne "M", hors entête)

 

[justinev]

Re : VBA ou autres formules ! Calcul moyenne en fonction de, tant que

Re,

Gentil n'est pas le mot que je lui attribuerai en ce moment ! Surtout lorsqu'il ne prend pas mes formules de 2km à cause d'un format de cellule !

J'avais bien modifié ColM pour lui attribué la colonne M.

Mon tableau démarrera toujours à la ligne 4, l'entête en ligne 3.

Merci !

 

[VDAVID]

Re : VBA ou autres formules ! Calcul moyenne en fonction de, tant que

Re,

Un peu tatillon alors

Si l'entête est en ligne 3, cela signifie que ton tableau commence en ligne "4", (Là où commence les nombres).

Du coup il faut modifier la variable LStart

De:

LStart = 3

à

LStart = 4


L'erreur que tu as est logique du coup, car la macro essayait d'additionner les entêtes ! (Ce qui n'est pas possible)
J'aurais dû être plus clair sur la nature de cette variable autant pour moi !

 

[justinev]

Re : VBA ou autres formules ! Calcul moyenne en fonction de, tant que

Re,

CA MARCHE !!!! OUHOUHOU !

Merci beaucoup !

 

[justinev]

Re : VBA ou autres formules ! Calcul moyenne en fonction de, tant que

Bonjour VDAVID,

Tu as l’air de maitriser le vba et je voulais savoir si tu voyais des améliorations à effectuer afin que mon fichier soit plus rapide.

Mon objectif est de calculer le cout destination/produit en tonne/euros.
A partir d’une extraction SAP, je mets donc en place mon fichier. Je récupère et tri les données, puis je dois répartir les livraisons en fonction des transporteurs.

1er problème : J’avais fait des filtres élaborés en vba mais le code n’est pas stable et j’ai eu beaucoup d’erreur. J’ai donc du appliquer un filtrage simple avec des copier-collers, plus lent…

Puis, je dois calculer le prix de chaque livraison en fonction des grilles tarifaires.

2eme problème : Je lui demande un copier-coller des datas car je ne sais pas coder en vba. La macro me renvois souvent des erreurs car les formats ne sont pas les bons, c’est long mais je ne vois pas d’autres solutions.

Si tu as le temps de m’aider, ça serait vraiment gentil !

Ci-dessous ma macro :

Sub Macro()


Workbooks.Open Filename:="P:\Projet\PROJET CALCULS\export.MHTML"

Windows("export.MHTML").Activate

'Recherche et suppression du mot "Emballage Cable"

Dim i As Integer
For i = [A65000].End(xlUp).Row To 1 Step -1
If Not Cells(i, 42).Find(What:="PAL") Is Nothing Or _
Not Cells(i, 42).Find(What:="tou") Is Nothing Or _
Not Cells(i, 42).Find(What:="SACH") Is Nothing Or _
Not Cells(i, 1).Find(800) Is Nothing Or _
Not Cells(i, 42).Find(What:="Emballage Câble") Is Nothing Then Rows(i).Delete
Next i


'Tri des données par BL

ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A2:A4511" _
), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A1:CD4511")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

'Copie des données SAP "export" dans fichier "Projet" - A Mettre dans le même dossier


Range("A:A, E:E, Q:Q, AP:AP, AU:AU, AW:AW, BM:BM, BJ:BJ, BP:BP, CD:CD").Select
Selection.Copy
Windows("Copie de PROJET1.xlsm").Activate
Columns("A:J").Select
ActiveSheet.Paste

Windows("export.MHTML").Activate
ActiveWindow.Close


'Filtre Kuehne Nagel

'Columns("J:J").Select
'Selection.AutoFilter
'ActiveSheet.Range("$J$1:$J$2069").AutoFilter Field:=1, Criteria1:= _
"KUEHNE + NAGEL ROAD"

' Range("A:L").Select
'Selection.Copy
'Sheets("Kuehne Nagel").Select
' Range("A3").Select
'ActiveSheet.Paste

'Filtre Schenker

Sheets("Données").Select
Columns("J:J").Select
Selection.AutoFilter
ActiveSheet.Range("$J$1:$J$2069").AutoFilter Field:=1, Criteria1:= _
"DB SCHENKER"

Range("A:L").Select
Selection.Copy
Sheets("Schenker").Select
Range("A3").Select
ActiveSheet.Paste

'Filtre Ziegler

Sheets("Données").Select
Columns("J:J").Select
Selection.AutoFilter
ActiveSheet.Range("$J$1:$J$2069").AutoFilter Field:=1, Criteria1:= _
"TRANSPORTS ZIEGLER"

Range("A:L").Select
Selection.Copy
Sheets("Ziegler").Select
Range("A3").Select
ActiveSheet.Paste

' Filtre Droin

'Sheets("Données").Select
'Columns("J:J").Select
'Selection.AutoFilter
'ActiveSheet.Range("$J$1:$J$2069").AutoFilter Field:=1, Criteria1:= _
"DROIN"

'Range("A:L").Select
'Selection.Copy
'Sheets("Droin").Select
'Range("A3").Select
'ActiveSheet.Paste

' Filtre LFB

Sheets("Données").Select
Columns("J:J").Select
Selection.AutoFilter
ActiveSheet.Range("$J$1:$J$2069").AutoFilter Field:=1, Criteria1:= _
"LA FLECHE BRESSANE"

Range("A:L").Select
Selection.Copy
Sheets("LFB").Select
Range("A3").Select
ActiveSheet.Paste


'Calculs du cout BL/destination pour LFB

'Ouvrir grille tarifaire LFB - Copier Projet --> grille tarifaire

Sheets("LFB").Select
Range("L:L,H:H").Select
Selection.Copy

Workbooks.Open Filename:="P:\Projet\PROJET CALCULS\Grille tarifaire LFB1.XLS"
Sheets("Poids calcul").Select
Range("A:A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Copier/ coller VALEUR grille tarifaire LFB --> Projet

Sheets("Poids Calcul").Select
Columns("D").Select
Selection.Copy
Windows("Copie de Copie de PROJET1.xlsm").Activate
Sheets("LFB").Select
Columns("M:M").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Windows("Grille tarifaire LFB1.XLS").Activate
ActiveWindow.Close

'Calculs du cout BL/destination pour Schenker

Sheets("Schenker").Select
Range("L:L,H:H").Select
Selection.Copy

Workbooks.Open Filename:="P:\Projet\PROJET CALCULS\Grille tarifaire Schenker.xlsx"
Sheets("Poids calcul").Select
Range("A:A").Select
ActiveSheet.Paste

'Copier/ coller VALEUR grille tarifaire Schenker --> Projet

Sheets("Poids Calcul").Select
Columns("E:E").Select
Selection.Copy
Windows("Copie de PROJET1.xlsm").Activate
Sheets("Schenker").Select
Columns("M:M").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Windows("Grille tarifaire Schenker.XLSX").Activate
ActiveWindow.Close

'Calculs du cout BL/destination pour Ziegler

Sheets("Ziegler").Select
Range("H:H,L:L").Select
Selection.Copy

Workbooks.Open Filename:="P:\Projet\PROJET CALCULS\Grille tarifaire ZIEGLER.xlsx"
Sheets("Poids calcul").Select
Range("A:A").Select
ActiveSheet.Paste

'Copier/ coller VALEUR grille tarifaire Ziegler --> Projet

Sheets("Poids Calcul").Select
Columns("E:E").Select
Selection.Copy
Windows("Copie de PROJET1.xlsm").Activate
Sheets("Ziegler").Select
Columns("M:M").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Windows("Grille tarifaire ZIEGLER.XLSX").Activate
ActiveWindow.Close

'Effacement des données dans la feuille données

Windows("Copie de PROJET1.xlsm").Activate
Sheets("Données").Select
[A:J].ClearContent

'Moyenne du poids de chaque câble par BL

Set Ws = Sheets("Schenker")

'Colonne où se trouve les livraisons
ColL = "A"

'Colonne où se trouve les poids totals par BL
ColM = "M"

'Ligne de départ du tableau
LStart = 4

NbMoy = 0

'4 est la ligne de départ du tableau

With Ws

LFin = .Range(ColL & 65536).End(xlUp).Row

tabl = .Range(ColL & LStart & ":" & ColM & LFin).Value
ReDim Preserve tabl(UBound(tabl()), UBound(tabl(), 2) + 1)

For i = LBound(tabl()) To UBound(tabl())

For h = LBound(tabl()) To UBound(tabl())

If tabl(h, LBound(tabl(), 2)) = tabl(i, LBound(tabl(), 2)) Then

tabl(i, UBound(tabl(), 2)) = tabl(i, UBound(tabl(), 2)) + tabl(h, UBound(tabl(), 2) - 1)
NbMoy = NbMoy + 1

End If

Next h
If NbMoy > 0 Then tabl(i, UBound(tabl(), 2)) = tabl(i, UBound(tabl(), 2)) / NbMoy
NbMoy = 0

Next i
.Range(Cells(LStart, .Range(ColL & 1).Column), .Cells(LFin, Range(ColM & 1).Column + 1)).Value = tabl

End With



End Sub

 

[VDAVID]

Re : VBA ou autres formules ! Calcul moyenne en fonction de, tant que

Salut Justinev !

Je vais essayer de regarder ça dans la soirée

Bonne journée !

 

[justinev]

Re : VBA ou autres formules ! Calcul moyenne en fonction de, tant que

'
'
D'accord merci beaucoup !