Come scrivere una raccolta VBA su un foglio Excel

Question

Ho un codice esistente che sto modificando. Questo codice crea una raccolta di righe da tabelle di fogli di lavoro preesistenti. Crea una grande raccolta bidimensionale, con informazioni distinte in ogni colonna. Esiste un modulo di classe separato che dichiara il tipo di dati per ciascuna colonna.

Il codice scrive la raccolta 2-D in un nuovo foglio facendo scorrere a turno ciascuna voce. Non ho mai usato una collezione prima e vorrei scrivere la raccolta sul foglio in un solo passaggio. Il codice corrente impiega molto tempo quando la tabella ha molti record.

C'è un modo per convertire l'intera raccolta in un array 2-D, o in modo che io possa quindi scrivere l'array 2-D in un unico passaggio? O c'è un modo per scrivere l'intera collezione sul foglio, proprio come con un array 2-D? Ho provato a cercare questo e fino ad ora non ho avuto successo. Qualsiasi punto generale sarebbe apprezzato!

Ecco alcuni esempi di codice, con commenti in grassetto, per illustrare come viene utilizzata la raccolta.

Definire il modulo di classe, come il nome TableEntry

Public Item1 As String 
Public Item2 As String 
Public Item3 As String 
Public Item4 As Integer 
Public Item5 As Integer 

principale Routine - creare la collezione, Riempire la Collezione, Scrivi Collection Foglio

Sub MainRoutine() 

Dim table As Collection 
Set table = New Collection 

Call FillCollection(File As String, ByRef table As Collection) 

Call WriteCollectionToSheet(ByRef table As Collection) 

Sub Routine 1 - Riempi la collezione

Dim wb As Workbook 
Set wb = Workbooks.Open(File) 

Dim ws As Worksheet 
For Each ws In ActiveWorkbook.Worksheets 

Dim R As Range 
Set R = ws.Range("A2") 

    Dim e As TableEntry 
    For i = 1 To 20 

    Set e = New TableEntry 

    e.Item1 = R.Offset(i + 1, 0).Offset(0, 0) 
    e.Item2 = R.Offset(i + 1, 0).Offset(0, 1) 
    e.Item3 = R.Offset(i + 1, 0).Offset(0, 2) 
    e.Item4 = R.Offset(i + 1, 0).Offset(0, 3) 
    e.Item5 = R.Offset(i + 1, 0).Offset(0, 4) 

    table.Add e 

    Next i 

Next ws 

Sub Routine 2 - Scrivi Collection Foglio

Answer 1

Penso che il modo più semplice per stampare un dizionario sul foglio di calcolo Excel è quello di utilizzare WorksheetFunction.Transpose(VarianttipoArray)

Il seguente codice

• di creare un dizionario campione con chiavi e oggetti
• crea due array (chiavi, oggetti) e li riempie con i elementi dal dizionario in una volta
• Utilizzi WorksheetFunction.Transpose(VariantArray) a le matrici di stampa in un colpo solo

Option Explicit 

'Aggiungi riferimento a Microsoft Scripting Runtime ' >> Strumenti >> Referenze >> Microsoft Scripting Runtime

Sub CollectionToArrayToSpreadSheet() 
    Cells.ClearContents 
    ' think of this collection as 
    ' key  = cell.row 
    ' item = cell.value 
    Dim dict As New Dictionary 
    dict.Add Key:=1, Item:="value1" 
    dict.Add Key:=2, Item:="value2" 
    dict.Add Key:=3, Item:="value3" 

    ' THIS WAY 
    'Range("A1:A" & UBound(dict.Keys) + 1) = WorksheetFunction.Transpose(dict.Keys) 
    'Range("B1:B" & UBound(dict.Items) + 1) = WorksheetFunction.Transpose(dict.Items) 

    ' OR 
    Range("A1").Resize(UBound(dict.Keys) + 1, 1) = WorksheetFunction.Transpose(dict.Keys) 
    Range("B1").Resize(UBound(dict.Items) + 1, 1) = WorksheetFunction.Transpose(dict.Items) 

End Sub 

---

Aggiornamento:

Nel tuo caso ...

Se questo è ciò che si sta cercando di fare (notatableè una raccolta)

Range("A1:A" & table.Count) = WorksheetFunction.Transpose(table) 

Purtroppo, la risposta è no.

Non è possibile trasporre una raccolta in un foglio di calcolo senza iterare attraverso la raccolta.

Che cosa si può fare per accelerare il processo di up è:

• spegnere Application.ScreenUpdating
• iterate sulla raccolta e copiare i valori sopra a un array, quindi utilizzare il WorksheetFunction.Transpose() stampare tutto per foglio in una volta (usa la logica dal primo parte della risposta)

Follow up:

Nel tuo caso si può riscrivere la Sub WriteCollectionToSheet(ByRef table As Collection) come questo (il codice è un po 'brutto, ma l'efficienza dovrebbe essere OK)

Sub WriteCollectionToSheet(ByRef table As Collection) 

    Dim dict1 As New Dictionary 
    Dim dict2 As New Dictionary 
    Dim dict3 As New Dictionary 
    Dim dict4 As New Dictionary 
    Dim dict5 As New Dictionary 

    Dim i As Long 
    For i = 1 To table.Count 
     dict1.Add i, table.Item(i).Item1 
     dict2.Add i, table.Item(i).Item2 
     dict3.Add i, table.Item(i).Item3 
     dict4.Add i, table.Item(i).Item4 
     dict5.Add i, table.Item(i).Item5 
    Next i 

    Range("A1:A" & UBound(dict1.Items) + 1) = WorksheetFunction.Transpose(dict1.Items) 
    Range("B1:B" & UBound(dict2.Items) + 1) = WorksheetFunction.Transpose(dict2.Items) 
    Range("C1:C" & UBound(dict3.Items) + 1) = WorksheetFunction.Transpose(dict3.Items) 
    Range("D1:D" & UBound(dict4.Items) + 1) = WorksheetFunction.Transpose(dict4.Items) 
    Range("E1:E" & UBound(dict5.Items) + 1) = WorksheetFunction.Transpose(dict5.Items) 

End Sub 

Maggiori dettagli su VBA Collezioni iterazioni e stampa su Sheet @vba4all.com

Answer 2

Se voglio scrivere un array 2D che ho inserito nel codice in un foglio di lavoro, utilizzo questo codice. E 'molto efficiente, in quanto solo 'parla' al foglio di lavoro, una volta

Dim r as Range 
Dim var_out as Variant 
Set r = Range("OutputValues") 
r.clear 
var_out = r.value 

'Then use code to appropriately fill the new 2D array var_out, such as your subroutine 1 above 

r.value = var_out 

di iniziare a individuare l'intervallo nella cartella di lavoro che si desidera la matrice per stampare. In questo esempio, presumo di aver chiamato l'intervallo di output "OutputValues".

Il primo assegnamento di r.value a var_out (la mia variabile di matrice che intendo popolare) imposta le dimensioni della variabile di matrice in base alla dimensione dell'intervallo. (Si legge anche in tutti i valori esistenti nell'intervallo, quindi se non lo desideri, cancella l'intervallo come mostrato qui.)

Il secondo assegnazione della variabile di matrice all'intervallo scrive i valori indietro al foglio.