2013-08-14 16 views
7

Mam istniejący kod, który modyfikuję. Ten kod tworzy kolekcję wierszy z istniejących tabel arkusza roboczego. Tworzy dużą kolekcję 2-D, z odrębnymi informacjami w każdej kolumnie. Istnieje oddzielny moduł klasy, który deklaruje typ danych dla każdej kolumny.Jak napisać kolekcję VBA do arkusza Excela

Kod zapisuje kolekcję 2-D do nowego arkusza, przechodząc kolejno przez każdy element. Nigdy wcześniej nie korzystałem z kolekcji i chciałbym zapisać kolekcję na arkuszu w jednym przebiegu. Obecny kod zajmuje dużo czasu, gdy tabela zawiera wiele rekordów.

Czy istnieje sposób przekonwertowania całej kolekcji na tablicę 2D, czy też mogę napisać tablicę 2-D za jednym razem? Czy istnieje sposób na zapisanie całej kolekcji do arkusza, tak jak w przypadku macierzy 2D? Próbowałem tego szukać i jak dotąd nie udało się. Wszelkie ogólne punkty będą mile widziane!

Oto przykładowy kod, z wyróżnionymi pogrubioną czcionką, aby zilustrować, w jaki sposób kolekcja jest używana.

Zdefiniuj moduł klasy, nazwany jako TableEntry

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

Main Routine - Tworzenie Collection, Napełnij kolekcja, pisać Collection do Arkusza

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) 

podprogram 1 - Wypełnij kolekcję

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 

podprogram 2 - Napisz Collection do Arkusza

+0

Dzięki szmaty. Powinienem był to znaleźć. – psychonomics

+0

Odpowiedź w powyższym łączu używa tablicy zamiast kolekcji. Czy to właśnie powinienem robić, czy istnieje sposób na przeniesienie kolekcji do tablicy, czy też napisanie kolekcji w jednym przejściu? – psychonomics

+1

W rzeczywistości, po wyłączeniu aktualizacji ekranu i obliczeń, będzie wystarczająco szybki, nawet jeśli użyjesz pętli. – martin

Odpowiedz

5

Myślę, że najprostszym sposobem, aby wydrukować Słownik na arkuszu kalkulacyjnym Excel jest za pomocą WorksheetFunction.Transpose(VarianttypArray)

Poniższy kod:

  • Tworzy Dictionary próbki z kluczami i przedmiotów
  • tworzy dwie tablice (elementy, przedmioty) i wypełnia je z elementów ze słownika jednym zamachem
  • U ycie WorksheetFunction.Transpose(VariantArray) do drukuj tablice w jedynka

Option Explicit 

'Add Reference Microsoft Scripting Runtime ' >> Narzędzia >> Referencje >> 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 


Aktualizacja:

W twoim przypadku ...

Jeśli to jest to, co staramy się robić (nutętableto zbiór)

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

Niestety, odpowiedź brzmi NIE.

Nie można przenieść kolekcji do arkusza kalkulacyjnego bez wykonywania iteracji w kolekcji.

Co można zrobić, aby przyspieszyć proces w górę to:

  • wyłączyć Application.ScreenUpdating
  • iteracyjne nad kolekcji i skopiować wartości ponad do tablicy, następnie użyć WorksheetFunction.Transpose() wydrukować wszystko do arkusz w jednym iść (użyć logiki od pierwszego część odpowiedzi)

Kontynuacja:

W twoim przypadku można przepisać Sub WriteCollectionToSheet(ByRef table As Collection) tak (kod wygląda nieco brzydki, ale skuteczność powinna być 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 

Więcej szczegółów na kolekcje VBA iteracji i drukowanie na Arkusz @vba4all.com

+0

Dzięki @mehow. Konwersja do tablicy i drukowanie za jednym razem brzmi dobrze. Czy nadal mogę wypełnić tablicę elementami za jednym zamachem, jeśli zbiór jest określony jako 'Nowa kolekcja' zamiast' Nowy słownik'? – psychonomics

+1

@psychonomics patrz, w tym przypadku nie rozumiem, jak masz kolekcję 2D.W jaki sposób jest to realizowane i jak działa, ponieważ jedyną rzeczą, którą można uzyskać z kolekcji, jest '.Item (index)'. Czy możesz pokazać kod, w jaki sposób Twoja kolekcja jest zaimplementowana i wykorzystana? Mogę następnie zaktualizować swoją odpowiedź, aby pasowała do Twojego przypadku. 100% –

+0

Zaktualizowałem moje pytanie, aby dołączyć przykładowy kod. Powinno to wyjaśniać, w jaki sposób kolekcja jest wdrażana i wykorzystywana. Jeśli nie, daj mi znać. I dzięki za pomoc tutaj! – psychonomics

3

Jeśli chcę napisać tablicę 2D, którą wprowadziłem wewnątrz kodu do arkusza roboczego, używam tego kodu. Jest bardzo wydajny, gdyż tylko „rozmowy” do arkusza raz

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 

zacząć od określenia zakres w skoroszycie chcesz tablica drukować. W tym przykładzie założyłem, że nazwałem zakres wyjściowy "OutputValues".

Pierwsze przypisanie wartości r do zmiennej var_out (moja zmienna tablicy, którą zamierzam zapełnić) ustawia wymiary zmiennej tablicowej na podstawie rozmiaru zakresu. (Odczytuje również wszelkie istniejące wartości w zakresie, więc jeśli tego nie chcesz, wyczyść zakres, tak jak tutaj pokazałem.)

Drugie przypisanie zmiennej tablicowej do zakresu zapisuje wartości z powrotem do arkusza.

Powiązane problemy