Discussion :

[Leonard02]

Bonjour à tous,
Voici mon problème :

J’ai deux colonnes qui contiennent la mesure d’une valeur dans un puit de pétrole. Normalement en fonction de la profondeur mais je ne l’ai pas c’est pourquoi j’ai numéroté chaque valeur.

L’objectif est de trouver une zone commune entre les deux colonnes.
Ceci a déjà été fait dans la macro qui est donné avec le fichier (Merci à Papou !)

J’aimerais pouvoir changer la macro de telle sorte à trouver pour quelle bloc le coefficient de corrélation est maximale entre les deux (fonction COEFFICENT.CORRELATION(matrice1 ;matrice2)).

Ici il s’agit d’un cas idéal, c'est-à-dire qu’on trouve un bloc commun aux deux colonnes. Donc entre ces deux blocs le coefficient de corrélation est maximale (égal à 1). Mais imaginons que certaines valeurs de ce bloc changent, la macro ne fonctionnera plus.

Merci pour votre aide.

[AlphaScorpi]

Pour simplifier la procédure, j'ai placé le début des séries en ligne 1.




Ensuite la procédure calcul le coefficient de corrélation le plus élevé pour chacune des tailles de plage possible ( de 2 lignes à toutes les lignes)

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
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
Sub CalculCoef()
 
    Dim WS As Worksheet
    Dim i As Long, j As Long
    Dim R1 As Long, R2 As Long
    Dim mt() As Variant
    Dim k As Long
    Dim Coef As Double
 
    Set WS = ThisWorkbook.Worksheets("Sheet1")
    With WS
        k = .Cells(.Rows.Count, 1).End(xlUp).Row
        ReDim mt(1 To k - 1, 1 To 4)
        For i = 2 To k
 
            Coef = Application.WorksheetFunction.Correl(.Range(.Cells(1, 2), .Cells(i, 2)), .Range(.Cells(1, 4), .Cells(i, 4)))
            R1 = 1
            R2 = i
            For j = 2 To k + 1 - i
                If Application.WorksheetFunction.Correl(.Range(.Cells(j, 2), .Cells(j + i - 1, 2)), .Range(.Cells(j, 4), .Cells(j + i - 1, 4))) > Coef Then
                    Coef = Application.WorksheetFunction.Correl(.Range(.Cells(j, 2), .Cells(j + i - 1, 2)), .Range(.Cells(j, 4), .Cells(j + i - 1, 4)))
                    R1 = j
                    R2 = j + i - 1
                End If
            Next j
 
            mt(i - 1, 1) = i
            mt(i - 1, 2) = R1
            mt(i - 1, 3) = R2
            mt(i - 1, 4) = Coef
        Next i
    End With
 
    Set WS = ThisWorkbook.Worksheets("Sheet2")
    With WS
        .Cells(1, 1).Resize(, 4) = Array("nbr Ligne", "Ligne Debut", "Ligne Fin", "Coef")
        For i = 1 To UBound(mt, 1)
            For j = 1 To 4
                .Cells(i + 1, j) = mt(i, j)
            Next j
        Next i
    End With
 
End Sub

Enfin le résultat est affiché en page 2





---------------


Il suffit ensuite de relier cette procédure à l’événement worksheet de la feuille Sheet1

[Leonard02]

Salut,

Merci pour ton aide c'est exactement ce que je voulais mais peux-tu m'envoyer le fichier excel avec la macro intégrée. Je n'arrive pas à la faire fonctionner.
Merci