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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
| Private Sub CommandButton1_Click()
Dim R As Long, TB()
Dim i As Integer
Dim s As Integer
Dim j As Integer
Dim post As Integer
Dim init As Integer
Dim mm As Integer
Dim finn As Integer, postef1
'Sheets("Feuil1").Columns(8).ClearContents
' Sheets("Feuil1").Columns(9).ClearContents
' Sheets("Feuil1").Columns(7).ClearContents
R = RechFind(Range("A1"), ThisWorkbook.Name, "1", Range("O8:O27").Address, TB())
finn = 27 ' derni?re ligne avec valeur de longueur
init = 8 ' premi?re ligne avec valeur de longueur
postef1 = 7
If R > 0 Then
s = 0 'calcul de longueur entre BDO
For i = 0 To R - 1 ' nombre de BDO trouv?
post = CInt(Range(TB(i)).Row)
For j = init To post
mm = CInt(Sheets("1").Cells(j, 5).Value)
s = s + mm
Sheets("recap").Cells(2, postef1) = "Longueur" & init - 7
Sheets("recap").Cells(3, postef1) = s
Next j
init = post + 1
mm = Empty
s = Empty
postef1 = postef1 + 1
'Sheets("Feuil1").Cells(3 + init, 8) = "Longueur"
Next i
If post < finn Then
init = post + 1
For j = init To finn
mm = CInt(Sheets("1").Cells(j, 5).Value)
s = s + mm
Next j
Sheets("recap").Cells(2, postef1) = "Longueur" & init - 7
Sheets("recap").Cells(3, postef1) = s
End If
Else
For j = init To finn
mm = CInt(Sheets("1").Cells(j, 5).Value)
s = s + mm
Next j
Sheets("recap").Cells(2, postef1) = "Longueur" & init - 7
Sheets("recap").Cells(3, postef1) = s
mm = Empty
s = Empty
postef1 = postef1 + 1
End If
End Sub
Option Explicit
Option Base 1
Option Compare Text
'Retourne toutes les adresses trouvées dans la recherche
'WkbN = nom du classeur, avec cette donnée la fonction peut étre mise dans un xla
'WksN = nom de la feuille
'Plage = les coordonn?es de la plage ? parcourir.
'Retour dans le tableau donner en argument.
Function RechFind(ByVal Cle As String, ByVal WkbN As String, ByVal WksN As String, ByVal Plage As String, ByRef TBadress() As Variant) As Long
Dim Cherche, Ix As Long, PrAddress
'Ix = 0
With Workbooks(WkbN).Sheets(WksN).Range(Plage)
Set Cherche = .Find(Cle)
Sheets("recap").Cells(3, 8) = Cherche
If Not Cherche Is Nothing Then
PrAddress = Cherche.Address
Do
ReDim Preserve TBadress(Ix)
TBadress(Ix) = Cherche.Address
Set Cherche = .FindNext(Cherche)
Ix = Ix + 1
Loop While Not Cherche Is Nothing And Cherche.Address <> PrAddress
End If
End With
'nombre d'occurence(s) trouv?e(s), Retour 0 si aucune occurence
RechFind = Ix
Set Cherche = Nothing 'Lib?re la m?moire occup?e par l'objet.
End Function |
