Cách viết bộ sưu tập VBA vào trang tính Excel

Question

Tôi có một số mã hiện có mà tôi đang sửa đổi. Mã này tạo ra một tập hợp các hàng từ các bảng tính có sẵn từ trước. Nó tạo ra một bộ sưu tập 2-D lớn, với thông tin riêng biệt trong mỗi cột. Có một mô-đun lớp riêng biệt khai báo kiểu dữ liệu cho mỗi cột.

Mã ghi bộ sưu tập 2-D vào trang tính mới bằng cách lặp lại từng mục. Trước đây tôi chưa từng sử dụng bộ sưu tập nào và muốn viết bộ sưu tập vào trang tính trong một lần gửi. Mã hiện tại mất khá nhiều thời gian khi bảng có nhiều bản ghi.

Có cách nào để chuyển đổi toàn bộ bộ sưu tập thành mảng 2-D hay để tôi có thể viết mảng 2-D chỉ bằng một lần? Hoặc là có một cách để viết toàn bộ bộ sưu tập vào bảng, giống như với một mảng 2-D? Tôi đã cố gắng tìm kiếm điều này và cho đến nay đã không thành công. Bất kỳ điểm chung nào sẽ được đánh giá cao!

Dưới đây là một số mã mẫu, với chú thích in đậm, để minh họa cách sử dụng bộ sưu tập.

Xác định Module Class, được đặt tên như TableEntry

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

chính định kỳ - Tạo bộ sưu tập, Điền bộ sưu tập, Viết Bộ sưu tập để tấm

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 - Điền vào Bộ sưu tập

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 thường xuyên 2 - Viết Bộ sưu tập để tấm

Answer 1

Tôi nghĩ rằng cách dễ nhất để in một điển vào bảng tính Excel là sử dụng WorksheetFunction.Transpose(VariantloạiArray)

Mã bên dưới

• Tạo một từ điển mẫu với các phím và các mặt hàng
• Tạo hai Mảng (phím, các mục) và điền chúng với yếu tố từ điển trong một đi
• Sử dụng WorksheetFunction.Transpose(VariantArray) để mảng in trong một lần

Option Explicit 

'Add Reference để Microsoft Scripting Runtime ' >> Tools >> Tham khảo >> 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 

---

Cập nhật:

Trong trường hợp của bạn ...

Nếu đây là những gì bạn đang cố gắng làm (lưu ýtablelà một Bộ sưu tập)

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

Thật không may, câu trả lời là KHÔNG.

Bạn không thể chuyển đổi bộ sưu tập sang bảng tính mà không cần lặp qua bộ sưu tập.

gì bạn có thể làm để tăng tốc độ quá trình lên là:

• tắt Application.ScreenUpdating
• lặp trong việc thu thập và sao chép các giá trị trên vào một mảng, sau đó sử dụng WorksheetFunction.Transpose() in tất cả mọi thứ để tờ trong một lần (sử dụng logic từ phần đầu tiên của câu trả lời)

Theo dõi:

Trong trường hợp của bạn, bạn có thể viết lại Sub WriteCollectionToSheet(ByRef table As Collection) như thế này (mã trông hơi xấu xí nhưng hiệu quả nên được 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 

tin chi tiết về VBA Bộ sưu tập lặp đi lặp lại và in tới Sheet @vba4all.com

Answer 2

Nếu tôi muốn viết một mảng 2D mà tôi đã điền vào bên trong mã vào một trang tính, tôi sử dụng mã này. Nó rất hiệu quả, vì nó chỉ 'nói' với bảng tính một lần

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 

Bạn bắt đầu bằng cách xác định phạm vi trong sổ làm việc bạn muốn mảng in. Trong ví dụ này, tôi giả sử tôi đặt tên cho dải đầu ra "OutputValues".

Bài tập đầu tiên của r.value cho var_out (biến mảng của tôi mà tôi dự định điền) đặt thứ nguyên của biến mảng dựa trên kích thước của dải ô. (Nó cũng đọc trong bất kỳ giá trị hiện có trong phạm vi, vì vậy nếu bạn không muốn điều đó, hãy xóa phạm vi như tôi đã hiển thị ở đây.)

Việc gán thứ hai của biến mảng vào dãy ghi lại giá trị vào trang tính.