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
| Sub YearSplit()
Dim iI As Integer
Dim iStep As Integer
Dim rRange As Range
Dim sBuffer As String
Dim vCell As Variant
Set rRange = Range([A1], Cells(Cells.SpecialCells(xlLastCell).Row, 1))
For Each vCell In rRange
sBuffer = "'" ' Apostrophe sert à forcer la cellule en Texte
If IsNumeric(vCell) Then
If Val(vCell) < Val(vCell.Offset(0, 1)) Then
iStep = 1
Else
iStep = -1
End If
For iI = Val(vCell) To Val(vCell.Offset(0, 1)) Step iStep
sBuffer = sBuffer & CStr(iI) & ","
Next iI
sBuffer = Left(sBuffer, Len(sBuffer) - 1) ' Suppression de la dernière virgule
Else
sBuffer = sBuffer & CStr(vCell.Offset(0, 1))
End If
vCell.Offset(0, 2) = sBuffer
Next vCell
End Sub |
