Incolla VBA serie

Question

Ho questo codice che popolerà una matrice

Sub rangearray() 

    Dim arr() As Variant 
    Dim Rng As Range 
    Dim myCell As Range 
    Dim i As Integer 

    Set Rng = ActiveSheet.Range("G10:G14") 

    For Each myCell In Rng 
     ReDim Preserve arr(i) 
     arr(i) = myCell 
     i = i + 1 
    Next myCell 

    ActiveSheet.Range("H10:H14") = arr() 

End Sub 

Qui potete vedere che i valori nella finestra di controllo sono ciò che è stata eseguita in

Tranne, quando aggiungo l'array alla cartella di lavoro, viene incollato solo il primo elemento dell'array.

E 'possibile incollare l'intera matrice al foglio di lavoro, senza dover scorrere l'array?

UPDATE Dopo aver dato un'occhiata al link da Sorceri ho modificato per codice per utilizzare la funzione .Transpose, quindi il mio codice modificato apparire così:

Sub rangearray() 

    Dim arr() As Variant 
    Dim Rng As Range 
    Dim myCell As Range 
    Dim i As Integer 

    Set Rng = ActiveSheet.Range("A1:A5") 

    For Each myCell In Rng 
     ReDim Preserve arr(i) 
     arr(i) = myCell 
     i = i + 1 
    Next myCell 

    ActiveSheet.Range("B1:B5") = WorksheetFunction.Transpose(arr) 

End Sub 

Answer 1

Si vuole utilizzare la funzione trasposizione del foglio di lavoro http://msdn.microsoft.com/en-us/library/office/ff196261.aspx

Vedere di seguito. Bisogna assegnare al valore della gamma

Sub rangearray() 

Dim arr() As Variant 
Dim Rng As Range 
Dim myCell As Range 
Dim i As Integer 

Set Rng = ActiveSheet.Range("A1:A5") 

For Each myCell In Rng 
    ReDim Preserve arr(i) 
    arr(i) = myCell 
    i = i + 1 
Next myCell 

ActiveSheet.Range("B1:B5").Value = WorksheetFunction.Transpose(arr) 

End Sub 

Answer 2

Come ho detto nel mio commento di cui sopra che non è necessario un array per eseguire l'azione che stai cercando di fare, ma ancora se desideri solo una soluzione di matrice allora si non c'è bisogno di fare il lungo cammino di riempire l'array in un ciclo. Assegna direttamente il valore dell'intervallo all'array. Creerà un array 2D che non è necessario trasporre.

Sub rangearray() 
    Dim arr 
    Dim Rng As Range 

    With ActiveSheet 
     Set Rng = ActiveSheet.Range("G10:G14") 

     arr = Rng.Value 

     .Range("H10").Resize(UBound(arr, 1)).Value = arr 
    End With 
End Sub