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
   | Private Function getArrayFromRange(Item As Range, Optional Tri As Boolean = True)
'volée à Pierre Fauconnier
    If WorksheetFunction.CountA(Item) > 0 Then
        If WorksheetFunction.CountA(Item) = 1 Then
            If Item.ListObject Is Nothing Then
                Dim t(1, 1)
                t(1, 1) = Item.Cells(1).Value
                getArrayFromRange = t
            Else
                getArrayFromRange = Array(Item.Cells(1).Value)
            End If
        Else
            'Dim v
            getArrayFromRange = Item.SpecialCells(xlCellTypeConstants).Value
            If Tri Then TriTab getArrayFromRange, LBound(getArrayFromRange), UBound(getArrayFromRange)
            'getArrayFromRange = v
        End If
    Else
        getArrayFromRange = Array(vbNullString)
    End If
End Function
Private Sub TriTab(ByRef Tableau As Variant, Mini As Long, Maxi As Long)
    Dim i As Long, j As Long, Pivot As Variant, TEMP As Variant
        On Error Resume Next
        i = Mini: j = Maxi
        Pivot = Tableau((Mini + Maxi) \ 2, 1)
        While i <= j
            While Tableau(i, 1) < Pivot And i < Maxi: i = i + 1: Wend
            While Pivot < Tableau(j, 1) And j > Mini: j = j - 1: Wend
            If i <= j Then
                TEMP = Tableau(i, 1)
                Tableau(i, 1) = Tableau(j, 1)
                Tableau(j, 1) = TEMP
                i = i + 1: j = j - 1
            End If
        Wend
        If (Mini < j) Then Call TriTab(Tableau, Mini, j)
        If (i < Maxi) Then Call TriTab(Tableau, i, Maxi)
    End Sub | 
Partager