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 |
