vba boucle

Question

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>

Mytå · Answer

Salut le forum

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å

Mytå · Answer

Re le forum

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å

vba · Answer

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

michel_m · Answer

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

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

michel_m · Answer

RE, 

 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

Mytå · Answer

Re le forum

Pourquoi une macro quand une formule fait le travail

Le fichier : Eq-Mean_Price.xls

Mytå

michel_m · Answer

Bonjour Myta,

la formule est bien sûr préférable mais la demande voulait du VBA...

Vba boucle

7 réponses

Discussions similaires

Newsletters