XL 2016 Remplir une plage depuis un tableau/array sans passer par une boucle

[Cyf]

Bonjour à tous,

J'essaie de me passer des boucles pour remplir des tableaux et des plages. Je présume que c'est plus rapide (peut-être à tort), en tout cas ça élague le code.

Ma situation est similaire au code illustratif ci-dessous :

Sub Exemple()

Dim Tbl As Variant
Dim Liste As String

Liste = "A;B;C;D;E;F"
Tbl = Split(Liste, ";")

ActiveSheet.Range("B2").Resize(UBound(Tbl) + 1, 1).Value2 = Tbl

End Sub

Mais de B2 à B7, je n'ai que la première valeur du tableau qui s'affiche. J'ai essayé toute une série de nuance sur l'avant dernière ligne (sans value2, sans la dimension de la colonne dans resize...), rien n'y fait. Est-ce que le problème ne viendrait pas de la fonction Split qui commence l'indexation à 0 ? Si oui, comment forcer l'indexation sur 1 pour cette fonction ?

Bien cordialement,

 

[Dudu2]

Bonjour,

Si moins de 65536 éléments:

ActiveSheet.Range("B2").Resize(UBound(Tbl) + 1, 1).Value2 = Application.Transpose(Tbl)

 

[Dudu2]

Si il y a plus de 65535 éléments, il faut du code pour transposer.
2 fonctions, l'une pour imiter le comportement de Application.Transpose, l'autre pour transposer "naturellement" en ne modifiant pas le nombre de dimensions de la table.

'--------------------------------------------------------------
'Fonction de Tranpose selon la logique de Application.Transpose
'sauf que Application.Transpose se limite à 65535 éléments
'alors que cette fonction lève cette limite.
'--------------------------------------------------------------
Function TransposeExcel(t As Variant) As Variant
    Dim tt() As Variant
    Dim NbDimensions As Integer
    Dim i As Long
    Dim j As Long
 
    If Not IsArray(t) Then
        MsgBox "Function TransposeExcel: error argument is not an array !"
        Exit Function
    End If
 
    '1 ou 2 dimensions pour t ?
    On Error Resume Next
    i = UBound(t, 2)
    If Err.Number Then NbDimensions = 1 Else NbDimensions = 2
    On Error GoTo 0

    '------------------------------------------------------
    'Tableau origine 1 dimension
    '=> Tableau destination 2 dimensions dont la 2ème est 1
    '------------------------------------------------------
    If NbDimensions = 1 Then
        ReDim tt(LBound(t) To UBound(t), 1 To 1)
    
        For i = LBound(t) To UBound(t)
            tt(i, 1) = t(i)
        Next i
    End If
 
    '----------------------------
    'Tableau origine 2 dimensions
    '----------------------------
    If NbDimensions = 2 Then
        '-----------------------------------------------
        'Tableau origine 2 dimensions dont la 2ème est 1
        '=> Tableau destination 1 dimension
        '-----------------------------------------------
        If UBound(t, 2) = 1 Then
            ReDim tt(LBound(t, 1) To UBound(t, 1))
        
            For i = LBound(t, 1) To UBound(t, 1)
                tt(i) = t(i, 1)
            Next i
        
        '-------------------------------------------------
        'Tableau origine 2 dimensions dont la 2ème est > 1
        '=> Tableau destination 2 dimensions inversées
        '-------------------------------------------------
        Else
            ReDim tt(LBound(t, 2) To UBound(t, 2), LBound(t, 1) To UBound(t, 1))
        
            For i = LBound(t, 2) To UBound(t, 2)
                For j = LBound(t, 1) To UBound(t, 1)
                    tt(i, j) = t(j, i)
                Next j
            Next i
        End If
    End If
 
    TransposeExcel = tt
End Function

'------------------------------------------------------------------
'Transpose "naturel" qui évite la réduction du nombre de dimensions
'lors de l'utilisation de WorksheetFunction.Transpose().
'Cette fonction conserve les 2 dimensions dans tous les cas.
'------------------------------------------------------------------
Function TransposeNaturel(t As Variant) As Variant
    Dim NbDimensions As Integer
    Dim tt() As Variant
    Dim i As Long
    Dim j As Long
 
    If Not IsArray(t) Then
        MsgBox "Function TransposeNaturel: error argument is not an array !"
        Exit Function
    End If
 
    '1 ou 2 dimensions pour t ?
    On Error Resume Next
    i = UBound(t, 2)
    If Err.Number Then NbDimensions = 1 Else NbDimensions = 2
    On Error GoTo 0
 
    't est un tableau à 1 dimension
    If NbDimensions = 1 Then
        TransposeNaturel = t
 
    't est un tableau à 2 dimensions
    ElseIf NbDimensions = 2 Then
        ReDim tt(LBound(t, 2) To UBound(t, 2), LBound(t, 1) To UBound(t, 1))
    
        For i = LBound(t, 2) To UBound(t, 2)
            For j = LBound(t, 1) To UBound(t, 1)
                tt(i, j) = t(j, i)
            Next j
        Next i
    
        TransposeNaturel = tt
    End If
End Function

 

[Cyf]

Merci pour cette réponse rapide !

A priori je devrai être en dessous des 65 000 éléments. Je vais quand même regarder de près et au pas à pas ces fonctions personnalisées que je garde sous le coude !

Merci à nouveau !