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
| Dim LastLig As Long, i As Long, Moy As Long, Dom As Long
Dim j As Integer, Nbre As Integer, NbIni As Integer, DimTablo As Integer
Dim c As Range
Dim Tablo()
ReDim Tablo(1 To 3, 1 To 1)
With Sheets("Feuil3")
For j = 1 To 37 Step 4
LastLig = .Cells(Rows.Count, j).End(xlUp).Row
Set c = .Range(.Cells(1, j), .Cells(LastLig, j)).Find("Moyens", lookat:=xlWhole)
If Not c Is Nothing Then
Moy = c.Row
Set c = .Range(.Cells(1, j), .Cells(LastLig, j)).Find("Domage", lookat:=xlWhole)
If Not c Is Nothing Then
Dom = IIf(c.Row > Moy, c.Row, Moy)
Moy = IIf(c.Row > Moy, Moy, c.Row)
Nbre = Dom - Moy - 1
NbIni = IIf(j = 1, 0, UBound(Tablo, 2))
DimTablo = NbIni + Nbre
ReDim Preserve Tablo(1 To 3, 1 To DimTablo)
For i = 1 To Nbre
Tablo(1, NbIni + i) = .Cells(Moy + i, j)
Tablo(2, NbIni + i) = FonctionPerso(.Cells(Moy + i, j))
Tablo(3, NbIni + i) = .Cells(Moy + i, j + 1)
Next i
End If
End If
Next j
MsgBox UBound(Tablo, 2)
.Range("C101:E" & 100 + UBound(Tablo, 2)) = Application.Transpose(Tablo)
End With |
Partager