Titre du sujet : Re: ecart
par JeanMarie le 19/03/2012 20:27:18
Bonsoir Mahelnawe, Didier, Le Forum
Ci-joint un code VBA qui traite une cellule colonne, il est facile de l'adapter pour traiter les 7 autres colonnes
Option Base 1
Sub Ecart()
'Déclaration des tableaux
Dim TabEcart() As Integer, TabArv() As Integer
'Déclaration des variables
Dim I As Integer, J As Integer, Z As Integer
Dim Connu As Boolean
'Calcul du dernier écart
'le tableau TabEcart est défini comme tableau à 3 colonnes
'la première colonne contiendra la valeur de la cellule
'la deuxième colonne contiendra le dernier écart connu suivant TabEcart(1,n)
'la troisième colonne contiendra la dernière ligne connue suivant TabEcart(1,n)
'le tableau TabArv contiendra la position dans le quinté
'Remise à zéro des variables
ReDim TabEcart(3, 1)
Z = 0
'Récupération de données sur la feuille de calcul "stc"
With Worksheets("stc")
'on commence à la ligne 3 jusqu'à la ligne ...
For I = 3 To .Range("J65536").End(xlUp).Row
Connu = False
'on teste si la valeur de la cellule Cells(I,10) est déjà connu dans le tableau
'la variable Z étant le nombre de valeurs uniques connues
For J = 1 To Z
If .Cells(I, 10) = TabEcart(1, J) Then
Connu = True
'Calcul de l'écart entre la nouvelle ligne et l'ancienne ligne conue de la valeur Cells(I, 10)
TabEcart(2, J) = I - TabEcart(2, J)
'Mémorisation de la ligne dans le tableau
TabEcart(3, J) = I
'on sort de la boucle
Exit For
End If
Next J
'Si la variable connu est false, la valeur Cells(I, 10) est une nouvelle valeur unique
If Connu = False Then
Z = Z + 1
'ajout dans le tableau d'uan nouvelle ligne
ReDim Preserve TabEcart(3, Z + 1)
'mémorisation des valeurs dans le tableau
TabEcart(1, Z) = .Cells(I, 10)
TabEcart(2, Z) = 0
TabEcart(3, Z) = I
End If
ReDim Preserve TabArv(I - 2)
TabArv(I - 2) = -1
'Cells(I, 10) est-il dans le quinté
'on commence à la colonne 2, et sur 5 colonnes
'l'index de ligne est donné par la valeur de la boucle principale
For J = 2 To 6
If .Cells(I, 10) = Worksheets("arv").Cells(I - 1, J) Then
TabArv(I - 2) = J - 1
Exit For
End If
Next J
Next I
End With
'Calcul de l'écart pondéré entre l'écart et le quinté
With Worksheets("ect")
'on commence à la ligne 18 sur le nombre valeur connue dans TabArv
For I = 18 To (UBound(TabArv) + 17)
Cells(I, 6) = IIf(TabArv(I - 17) = -1, .Cells(I - 1, 6) - 1, TabArv(I - 17))
For J = 1 To UBound(TabEcart())
If TabEcart(1, J) = TabArv(I - 17) Then
.Cells(I, 6) = .Celle(I, 6) + (TabEcart(2, J) / 100)
Exit For
End If
Next J
Next I
End With
End Sub
J'ai testé la macro, uniquement sur les valeurs de ton fichier, teste le STP.
J'espère qu'il n'y a pas trop de bêtises de dites, ou des abérations de programmation... étant plus un spécialiste dans les formules
@+Jean-Marie
|
Didier FOURGEOT