Vba boucle
vba
-
michel_m Messages postés 18903 Date d'inscription Statut Contributeur Dernière intervention -
michel_m Messages postés 18903 Date d'inscription Statut Contributeur Dernière intervention -
Bonjour,
Je suis débutante en vba et je travaille sur une macro vb sur laquelle je dois ajouter des choses.
J'ai besoin de votre aide pour ajouter une colonne qui effectue le calclul suivant
DIFF PRICE=Eq mean price/Eq mean price le plus elevé pour chaque item
pour l'item 1 on divisera par 6,02 pour l'item 2, 6.21 etc...
je voudrai faire une boucle(ou peut etre pas besoin?) qui me calcule ce diff price par exemple tant que item=1 on divise par 6.02 etc...
je ne sais pas comment ecrire le code pour cela
Merci beaucoup pour votre aide
Item Eq Mean Price
1 2,54
1 2,02
1 4,94
1 0,66
1 6,02
1 1,85
1 4,85
1 4,82
1 #VALEUR!
1 #VALEUR!
1 0,6
1 1,6
1 2,4
2 2,52
2 1,93
2 2,29
2 2,34
2 4,92
2 6,21
2 #VALEUR!
2 #VALEUR!
2 4
3 3,15
3 3,43
3 3,66
3 1,67
3 1,76
3 3,89
3 3,07
3 #VALEUR!
3 #VALEUR!
3 #VALEUR!
3 #VALEUR!
3 19,8
Vista / Internet Explorer 7.0</config>
Je suis débutante en vba et je travaille sur une macro vb sur laquelle je dois ajouter des choses.
J'ai besoin de votre aide pour ajouter une colonne qui effectue le calclul suivant
DIFF PRICE=Eq mean price/Eq mean price le plus elevé pour chaque item
pour l'item 1 on divisera par 6,02 pour l'item 2, 6.21 etc...
je voudrai faire une boucle(ou peut etre pas besoin?) qui me calcule ce diff price par exemple tant que item=1 on divise par 6.02 etc...
je ne sais pas comment ecrire le code pour cela
Merci beaucoup pour votre aide
Item Eq Mean Price
1 2,54
1 2,02
1 4,94
1 0,66
1 6,02
1 1,85
1 4,85
1 4,82
1 #VALEUR!
1 #VALEUR!
1 0,6
1 1,6
1 2,4
2 2,52
2 1,93
2 2,29
2 2,34
2 4,92
2 6,21
2 #VALEUR!
2 #VALEUR!
2 4
3 3,15
3 3,43
3 3,66
3 1,67
3 1,76
3 3,89
3 3,07
3 #VALEUR!
3 #VALEUR!
3 #VALEUR!
3 #VALEUR!
3 19,8
Vista / Internet Explorer 7.0</config>
7 réponses
Salut le forum
Si tu peux éviter les #Valeur!
La formule suivante à valider par Ctrl+Shift+Enter et recopier vers le bas
En C2
Mytå
Si tu peux éviter les #Valeur!
La formule suivante à valider par Ctrl+Shift+Enter et recopier vers le bas
En C2
=B2/MAX(SI($A$2:$A$35=A2;$B$2:$B$35))
Mytå
Re le forum
Si la plage contient des valeurs d'erreur
La formule à valider par Ctrl+Shift+Enter
Mytå
Si la plage contient des valeurs d'erreur
La formule à valider par Ctrl+Shift+Enter
=B2/MAX(($A$2:$A$35=A2)*SI(ESTERREUR($B$2:$B$35);0;$B$2:$B$35))
Mytå
bonjour et merci
en fait il faudrait faire le calcul a l'interieur de chaque item (pour le meme item prendre le max)
merci pour votre aide
en fait il faudrait faire le calcul a l'interieur de chaque item (pour le meme item prendre le max)
merci pour votre aide
Bonjour à tous,
vba, comme te l'avait indiqué Myta, #valeurcomplique énormément une solution. normalement, règle de base Excel, on doit traiter l'erreur AVANT en renvoyant une valeur "" ou 0 (0 dans notre cas puisqu'on va diviser)
la macro remplace donc #valeur! par 0
nombre de ligne maxi=10000-1
mais si on avait 0 au lieu d'erreur, la macro serait beaucoup + simple
vba, comme te l'avait indiqué Myta, #valeurcomplique énormément une solution. normalement, règle de base Excel, on doit traiter l'erreur AVANT en renvoyant une valeur "" ou 0 (0 dans notre cas puisqu'on va diviser)
la macro remplace donc #valeur! par 0
nombre de ligne maxi=10000-1
Option Explicit
Sub ratio()
Dim deb_item As Byte, fin_item As Integer, item_max As Integer
Dim cptr As Integer, cptr_tab As Integer, maxi As Double, cptr_item As Integer
Dim tablo
Application.ScreenUpdating = False
Range("C2:C10000").ClearContents
ReDim tablo(0)
item_max = Application.Max(Range("A2:A10000"))
For cptr = 1 To item_max
deb_item = Columns(1).Find(cptr, Range("A1")).Row
If cptr < item_max Then
fin_item = Columns(1).Find(cptr + 1, Range("A1")).Row - 1
Else
fin_item = Range("A10000").End(xlUp).Row
End If
ReDim Preserve tablo(0)
cptr_tab = 0
maxi = 0
For cptr_item = deb_item To fin_item
If IsError(Cells(cptr_item, 2)) Then: Cells(cptr_item, 2) = 0
tablo(cptr_tab) = Cells(cptr_item, 2)
cptr_tab = cptr_tab + 1
ReDim Preserve tablo(cptr_tab)
If Cells(cptr_item, 2) > maxi Then: maxi = Cells(cptr_item, 2)
Next
ReDim Preserve tablo(UBound(tablo) - 1)
For cptr_tab = 0 To UBound(tablo)
Cells(cptr_tab + deb_item, 3) = tablo(cptr_tab) / maxi
Next
Next
End Sub
mais si on avait 0 au lieu d'erreur, la macro serait beaucoup + simple
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
RE,
macro optimisée:
bonne soirée
Michel
macro optimisée:
Option Explicit
Sub ratio()
Dim derlig As Integer, deb_item As Byte, fin_item As Integer, item_max As Integer
Dim cptr As Integer, cptr_tab As Integer, maxi As Double, cptr_item As Integer
Dim tablo
'----initialisations
Application.ScreenUpdating = False
Range("C2:C10000").ClearContents
derlig = Range("A10000").End(xlUp).Row
ReDim tablo(0)
'nombre d'items
item_max = Application.Max(Range("A2:A10000"))
'-----prise en comte de #valeur remplacé par 0 (à supprimer si traitement avant de la feuille Excel)
For cptr = 2 To derlig
If IsError(Cells(cptr, 2)) Then: Cells(cptr, 2) = 0
Next
For cptr = 1 To item_max
' détermine les zones d'items
deb_item = Columns(1).Find(cptr, Range("A1"), xlValues).Row
'tient compte de la fin du dernier item
If cptr < item_max Then
fin_item = Columns(1).Find(cptr + 1, Range("A1"), xlValues).Row - 1
Else
fin_item = derlig
End If
'calcul la valeur maxi de la zone en cours
maxi = Application.Max(Range(Cells(deb_item, 2), Cells(fin_item, 2)))
'divise les valeurs de la zone en cours par le maxi de chaque zone dans l' array "tablo"
For cptr_item = deb_item To fin_item
tablo(cptr_tab) = Cells(cptr_item, 2) / maxi
cptr_tab = cptr_tab + 1
ReDim Preserve tablo(cptr_tab)
Next
Next
'ajuste la taille de l'array
ReDim Preserve tablo(UBound(tablo) - 1)
'restitue en colonne C
Range("C2").Resize(UBound(tablo) + 1, 1) = Application.Transpose(tablo)
End Sub
bonne soirée
Michel
Re le forum
Pourquoi une macro quand une formule fait le travail
Le fichier : Eq-Mean_Price.xls
Mytå
Pourquoi une macro quand une formule fait le travail
Le fichier : Eq-Mean_Price.xls
Mytå
merci pour tes reponses en fait le diff price doit etre calculé avec le max de chaque item c'est ce que je n'arrive pas a faire
donc diviser par 6.02,6.21 et 19.8
merci!