Xuất Dictionary ra sheet bị hiển thị lỗi

johnnylinhanh · 17/9/20

Chào mọi người,
Hiện em có viết đoạn code liệt kê các tổ hợp 3 của n phần tử như sau:

Mã:

Sub Listdetail()
Dim i, j, h, k As Long
Sheet2.Range("A6:C1048576").ClearContents
    If Sheet2.Range("C1") >= 0 And Sheet2.Range("C1") <= 800000 Then
        Dim dict As Object
        Set dict = CreateObject("Scripting.Dictionary")
        For i = 1 To Sheet2.Range("C2")
            For j = i + 1 To Sheet2.Range("C2")
                For h = j + 1 To Sheet2.Range("C2")
                    k = k + 1
                    dict.Add (i & "&" & j & "&" & h), k
                Next h
            Next j
        Next i
        Sheet2.[C6].Value = dict.Count
        Sheet2.[A6].Resize(dict.Count, 1).Value = Application.Transpose(dict.Items)
        Sheet2.[B6].Resize(dict.Count, 1).Value = Application.Transpose(dict.Keys)
    Else
        MsgBox "Please Input Number n of combination less 800,000 units"
    End If
    Set dict = Nothing
End Sub

Nhưng khi em xuất ra thì từ item thứ 49329 trở đi bị lỗi #N/A
Mong mọi người xem và chia sẽ em cách khắc phục trong trường hợp này với, cám ơn nhiều.

tigertiger · 17/9/20

johnnylinhanh đã viết:
Chào mọi người,
Hiện em có viết đoạn code liệt kê các tổ hợp 3 của n phần tử như sau:

Mã:

Sub Listdetail() Dim i, j, h, k As Long Sheet2.Range("A6:C1048576").ClearContents If Sheet2.Range("C1") >= 0 And Sheet2.Range("C1") <= 800000 Then Dim dict As Object Set dict = CreateObject("Scripting.Dictionary") For i = 1 To Sheet2.Range("C2") For j = i + 1 To Sheet2.Range("C2") For h = j + 1 To Sheet2.Range("C2") k = k + 1 dict.Add (i & "&" & j & "&" & h), k Next h Next j Next i Sheet2.[C6].Value = dict.Count Sheet2.[A6].Resize(dict.Count, 1).Value = Application.Transpose(dict.Items) Sheet2.[B6].Resize(dict.Count, 1).Value = Application.Transpose(dict.Keys) Else MsgBox "Please Input Number n of combination less 800,000 units" End If Set dict = Nothing End Sub

Nhưng khi em xuất ra thì từ item thứ 49329 trở đi bị lỗi #N/A
Mong mọi người xem và chia sẽ em cách khắc phục trong trường hợp này với, cám ơn nhiều.

Không nên dùng application.transpose
Vì có hạn chế số lượng

CHAOQUAY · 17/9/20

johnnylinhanh đã viết:
Chào mọi người,
Hiện em có viết đoạn code liệt kê các tổ hợp 3 của n phần tử như sau:

Mã:

Sub Listdetail() Dim i, j, h, k As Long Sheet2.Range("A6:C1048576").ClearContents If Sheet2.Range("C1") >= 0 And Sheet2.Range("C1") <= 800000 Then Dim dict As Object Set dict = CreateObject("Scripting.Dictionary") For i = 1 To Sheet2.Range("C2") For j = i + 1 To Sheet2.Range("C2") For h = j + 1 To Sheet2.Range("C2") k = k + 1 dict.Add (i & "&" & j & "&" & h), k Next h Next j Next i Sheet2.[C6].Value = dict.Count Sheet2.[A6].Resize(dict.Count, 1).Value = Application.Transpose(dict.Items) Sheet2.[B6].Resize(dict.Count, 1).Value = Application.Transpose(dict.Keys) Else MsgBox "Please Input Number n of combination less 800,000 units" End If Set dict = Nothing End Sub

Nhưng khi em xuất ra thì từ item thứ 49329 trở đi bị lỗi #N/A
Mong mọi người xem và chia sẽ em cách khắc phục trong trường hợp này với, cám ơn nhiều.

Có lẽ do giới hạn của hàm transpose.
Bạn lập mảng kết quả, gán giá trị cùng với nạp dict, sau đó điền xuống sheet chắc là được

johnnylinhanh · 17/9/20

CHAOQUAY đã viết:
Có lẽ do giới hạn của hàm transpose.
Bạn lập mảng kết quả, gán giá trị cùng với nạp dict, sau đó điền xuống sheet chắc là được

Nhưng kỳ lạ một chỗ mình test như trên file n = 146 thì đến item 49329 mới bị lỗi
Thử test với n = 100 thì từ item 30628 mới bị lỗi
n = 75 thì từ item 1990 bị lỗi
n = 74 thì hiển thị đủ và đúng 64824 item
Nên mình nghĩ vấn đề nó nằm ở chỗ khác chứ không phải bản thân hàm transpose và mình sẽ thử cách gán giá trị vào mảng xem sao

batman1 · 17/9/20

johnnylinhanh đã viết:
Nhưng kỳ lạ một chỗ mình test như trên file n = 146 thì đến item 49329 mới bị lỗi
Thử test với n = 100 thì từ item 30628 mới bị lỗi
n = 75 thì từ item 1990 bị lỗi
n = 74 thì hiển thị đủ và đúng 64824 item
Nên mình nghĩ vấn đề nó nằm ở chỗ khác chứ không phải bản thân hàm transpose và mình sẽ thử cách gán giá trị vào mảng xem sao

Hãy đá đít TRANSPOSE ngay và luôn. Và hãy quên nó mãi mãi.

Hãy thử nghiệm: tạo 1 tập tin mới với code

Mã:

Sub test()
Dim k As Long, a()
    ReDim a(1 To 70000)
    For k = 1 To 70000
        a(k) = k
    Next
    Sheet1.Range("C1").Resize(70000).Value = Application.Transpose(a)
End Sub

Sau đó chạy code. Nếu không thấy lỗi thì sửa 3 chỗ 70 000 thành 100 000. Nếu vẫn chưa thấy lỗi thì lại tăng thêm chút.

Nếu có lỗi thì hãy để ý là ở đây không có Dictionary để bạn đổ lỗi cho nó đâu nhé.

VetMini · 17/9/20

Đít sần chả có công dụng gì trong bài này cả.
Cứ ghi thẳng vào array có lẽ còn nhanh hơn.

Mã:

Sheet2.Range("A6:C1048576").ClearContents
    If Sheet2.Range("C1") >= 0 And Sheet2.Range("C1") <= 800000 Then
        Dim dict As Object
        Dim a(1 To 800000, 1 To 2)
        'Set dict = CreateObject("Scripting.Dictionary")
        For i = 1 To Sheet2.Range("C2")
            For j = i + 1 To Sheet2.Range("C2")
                For h = j + 1 To Sheet2.Range("C2")
                    k = k + 1
                    a(k, 1) = k
                    a(k, 2) = i & "&" & j & "&" & h
                    'dict.Add (i & "&" & j & "&" & h), k
                Next h
            Next j
        Next i
        Sheet2.[C6].Value = k
        Sheet2.[A6].Resize(k, 2).Value = a

        'Sheet2.[C6].Value = dict.Count
        'Sheet2.[A6].Resize(dict.Count, 1).Value = Application.Transpose(dict.Items)
        'Sheet2.[B6].Resize(dict.Count, 1).Value = Application.Transpose(dict.Keys)
    Else
        MsgBox "Please Input Number n of combination less 800,000 units"
    End If
    Set dict = Nothing
End Sub

Chú ý: lô gic về giới hạn của bài này sai.
Trong code không có gì giới hạn số combi ở 800000 cả.

johnnylinhanh · 18/9/20

batman1 đã viết:
Hãy đá đít TRANSPOSE ngay và luôn. Và hãy quên nó mãi mãi.

Hãy thử nghiệm: tạo 1 tập tin mới với code

Mã:

Sub test() Dim k As Long, a() ReDim a(1 To 70000) For k = 1 To 70000 a(k) = k Next Sheet1.Range("C1").Resize(70000).Value = Application.Transpose(a) End Sub

Sau đó chạy code. Nếu không thấy lỗi thì sửa 3 chỗ 70 000 thành 100 000. Nếu vẫn chưa thấy lỗi thì lại tăng thêm chút.

Nếu có lỗi thì hãy để ý là ở đây không có Dictionary để bạn đổ lỗi cho nó đâu nhé.

Em đã search và thấy thông tin kích thước tối đa mà hàm transpose xử lý là 2^16 = 65,536 dòng

VetMini đã viết:

Đít sần chả có công dụng gì trong bài này cả.
Cứ ghi thẳng vào array có lẽ còn nhanh hơn.

Mã:

Sheet2.Range("A6:C1048576").ClearContents
    If Sheet2.Range("C1") >= 0 And Sheet2.Range("C1") <= 800000 Then
        Dim dict As Object
        Dim a(1 To 800000, 1 To 2)
        'Set dict = CreateObject("Scripting.Dictionary")
        For i = 1 To Sheet2.Range("C2")
            For j = i + 1 To Sheet2.Range("C2")
                For h = j + 1 To Sheet2.Range("C2")
                    k = k + 1
                    a(k, 1) = k
                    a(k, 2) = i & "&" & j & "&" & h
                    'dict.Add (i & "&" & j & "&" & h), k
                Next h
            Next j
        Next i
        Sheet2.[C6].Value = k
        Sheet2.[A6].Resize(k, 2).Value = a

        'Sheet2.[C6].Value = dict.Count
        'Sheet2.[A6].Resize(dict.Count, 1).Value = Application.Transpose(dict.Items)
        'Sheet2.[B6].Resize(dict.Count, 1).Value = Application.Transpose(dict.Keys)
    Else
        MsgBox "Please Input Number n of combination less 800,000 units"
    End If
    Set dict = Nothing
End Sub

Chú ý: lô gic về giới hạn của bài này sai.
Trong code không có gì giới hạn số combi ở 800000 cả.

Thật ra đây là file nháp em để 800,000 là để ví dụ tạm thời sau sẽ set lại để kết quả không vượt quá 1,048,576 dòng
Ở đây em dùng Dictionary vì nguồn vào là một trường gồm list phần tử có thể trùng (có thể remove duplication trường này trước khi chạy code) và tranh thủ tìm hiểu nó luôn ạ

Cám ơn hai bác nhiều!

Xuất Dictionary ra sheet bị hiển thị lỗi

johnnylinhanh

Thành viên thường trực

File đính kèm

tigertiger

Coming back ...

CHAOQUAY

Thành viên gắn bó

johnnylinhanh

Thành viên thường trực

batman1

Thành viên gạo cội

VetMini

Ăn cùng góc phố

johnnylinhanh

Thành viên thường trực

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng