Interpolation de deux cellules

**gallus** · 21/03/2013, 20h30

Bonjour à tous,

Ceci est mon premier post sur un forum en général (pas seulement sur l'informatique), je ne connais donc pas les us et coutumes à respecter, veuillez ne pas me tenir rigueurs de mes erreurs, si erreur il y a !

Voilà je vous présente mon problème : je veux réaliser une macro sous VBA qui ferait une interpolation entre deux cellules, c'est à dire calculer la moyenne de ces cellules. En fait j'ai une plage de cellules, dont certaines sont vides. Je dois détecter ces cellules, et faire en sorte que ces cellules vides deviennent des moyennes entre la dernière cellule non nulle et la prochaine cellule non nulle. Est-ce que vous auriez des idées ? J'ai commencé par attribuer un nom à la colonne concernée

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set rgY2 = wsF.Range("T3")

puis je teste si une cellule est vide

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
For i = 1 To 1947
      If rgY2(i) = "" Then
             rgY2(i) = (rgY2(i - 1)+rgY2(i+1))/2
      End If
Next i

Seulement le problème c'est que ce programme suppose que chaque cellule vide est entourée de deux deux cellules non-vides, ce qui n'est pas le cas... J'ai parfois une cinquantaine de cellules qui sont vides, et je voudrais que ces 50 cellules soient de mêmes valeurs, soit la moyenne de la dernière cellule non vide et de la prochaine cellule non vide.

En espérant avoir été assez clair !

Merci à tous pour votre aide !

gallus

**Efgé2** · 21/03/2013, 21h16

Bonjour gallus,
Une proposition, mais avec juste une partie du code comme exemple, pas facile de modifier

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub Test()
Dim wsf As Worksheet, Plg As Range, R As Range
Dim X, Y
Set wsf = Sheets("Feuil1") ' a adapter
On Error Resume Next
Set Plg = wsf.Range("T3:T1950").SpecialCells(xlCellTypeBlanks)
If Err Then
    Err.Clear
    MsgBox "Pas de cellule vide", 64, "Compte rendu"
    Exit Sub
End If
For Each R In Plg.Areas
    X = R.Offset(-1, 0)(1, 1).Value
    Y = R.Offset(1, 0)(R.Rows.Count, 1).Value
    R = (X + Y) / 2
Next R
End Sub

Cordialement

**gallus** · 22/03/2013, 15h24

Ca marche parfaitement, je vous remercie !

gallus

Edit : J'ai fait une erreur sur l'interpolation. En fait si je pose :

p : numéro de la dernière ligne où il y avait une valeur non nulle
n : numéro de la prochaine ligne où il y aura une valeur non nulle
o : numéro de la ligne où je souhaite effectuer mon interpolation

la formule est :

((n-o) * valeur de la cellule en p + (o-p)* valeur de la cellule en n) / (n-p)

Y a-t-il un moyen d'adapter le code précédent pour qu'il prenne cette modification en compte ? Je sais que si j'ai affecté une cellule au range r par exemple, le numéro de la ligne est r.row, mais là je sèche un peu pour l'adaptation du code...

Merci pour votre aide !

**Efgé2** · 22/03/2013, 16h00

Bonjour gallus

Ca se complique

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub Test_2()
Dim wsf As Worksheet, Plg As Range, R As Range, Rr As Range
Dim P&, n&, o&, X As Variant, Y As Variant
Set wsf = Sheets("Feuil1") ' a adapter
On Error Resume Next
Set Plg = wsf.Range("T3:T1950").SpecialCells(xlCellTypeBlanks)
If Err Then
    Err.Clear
    MsgBox "Pas de cellule vide", 64, "Compte rendu"
    Exit Sub
End If
For Each R In Plg.Areas
    P = R.Offset(-1, 0)(1, 1).Row
    X = R.Offset(-1, 0)(1, 1).Value
    n = R.Offset(1, 0)(R.Rows.Count, 1).Row
    Y = R.Offset(1, 0)(R.Rows.Count, 1).Value
    For Each Rr In R
        o = Rr.Row
        Rr = ((n - o) * X + (o - P) * Y) / (n - P)
    Next Rr
Next R
End Sub

Cordialement