Nhờ chỉnh code pivot!!!

[excel_lv1.5]

Tôi có bảng data bên sheet1, tôi dùng code VBA để tạo ra một bảng pivot bên Sheet2, tuy nhiên code này quá chậm so với cách làm tay bình thường trong khi data thì không lớn, tôi biết nguyên nhân là do đoạn code loại bỏ dòng Total này:

On Error Resume Next
For Each pf1 In PT.PivotFields
    pf1.Subtotals(1) = True
    pf1.Subtotals(1) = False
Next pf1

Nhưng không biết chỉnh lại như thế nào, nhờ mọi người xem xét và chỉnh lại code lại để chạy nhanh hơn, xin cảm ơn!!

 

[Hai Lúa Miền Tây]

Tôi có bảng data bên sheet1, tôi dùng code VBA để tạo ra một bảng pivot bên Sheet2, tuy nhiên code này quá chậm so với cách làm tay bình thường trong khi data thì không lớn, tôi biết nguyên nhân là do đoạn code loại bỏ dòng Total này:

On Error Resume Next
For Each pf1 In PT.PivotFields
    pf1.Subtotals(1) = True
    pf1.Subtotals(1) = False
Next pf1

Nhưng không biết chỉnh lại như thế nào, nhờ mọi người xem xét và chỉnh lại code lại để chạy nhanh hơn, xin cảm ơn!!

Liệu có thể dùng ADO để làm ra được kết quả như vậy?

 

[excel_lv1.5]

Liệu có thể dùng ADO để làm ra được kết quả như vậy?

Vâng, nếu được bạn cho tôi xin code VBA dùng ADO, xin cảm ơn!!!

 

[Hai Lúa Miền Tây]

Vâng, nếu được bạn cho tôi xin code VBA dùng ADO, xin cảm ơn!!!

Bạn test thử code sau nhé:

Sub test()
    With CreateObject("ADODB.Connection")
        .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 12.0"
        Sheet2.Range("A2").CopyFromRecordset .Execute("TRANSFORM Sum([Thanhtien]) SELECT [Madv], [Mahd],[Macp],Tenhd, Tencp, Sum([Thanhtien]) FROM [Sheet1$A4:G] GROUP BY [Madv],[Mahd],[Macp],Tenhd,Tencp PIVOT [Nam]")
    End With
End Sub

 

[excel_lv1.5]

Bạn test thử code sau nhé:

Sub test()
    With CreateObject("ADODB.Connection")
        .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 12.0"
        Sheet2.Range("A2").CopyFromRecordset .Execute("TRANSFORM Sum([Thanhtien]) SELECT [Madv], [Mahd],[Macp],Tenhd, Tencp, Sum([Thanhtien]) FROM [Sheet1$A4:G] GROUP BY [Madv],[Mahd],[Macp],Tenhd,Tencp PIVOT [Nam]")
    End With
End Sub

Vâng cảm ơn bạn, để tôi chạy thử.

 

[Đừng Lắm Mồm]

Public Sub XYZ()
Dim sArr, dArr, C As Object, I As Long, K As Long, R As Object, N As Long, Col As Long, Rws As Long
sArr = Sheet1.Range("A4").CurrentRegion.Value
Set C = CreateObject("Scripting.Dictionary")
Set R = CreateObject("Scripting.Dictionary")
ReDim dArr(1 To UBound(sArr), 1 To 100)
dArr(1, 1) = "Madv": dArr(1, 2) = "Mahd"
dArr(1, 3) = "Tenhd": dArr(1, 4) = "Macp": dArr(1, 5) = "Tencp"
K = 1: N = 5
For I = 2 To UBound(sArr)
    If Not C.Exists(sArr(I, 1)) Then
        N = N + 1
        C.Add sArr(I, 1), N
        dArr(1, N) = sArr(I, 1)
    End If
            If Not R.Exists(sArr(I, 3) & "#" & sArr(I, 4)) Then
                K = K + 1
                R.Add sArr(I, 3) & "#" & sArr(I, 4), K
                dArr(K, 1) = sArr(I, 2)
                dArr(K, 2) = sArr(I, 3)
                dArr(K, 3) = sArr(I, 5)
                dArr(K, 4) = sArr(I, 4)
                dArr(K, 5) = sArr(I, 6)
            End If
                Rws = R.Item(sArr(I, 3) & "#" & sArr(I, 4))
                Col = C.Item(sArr(I, 1))
                dArr(Rws, Col) = dArr(Rws, Col) + sArr(I, 7)
Next
Sheet1.Range("I4").Resize(K, 49).Value = dArr
End Sub

 

[excel_lv1.5]

Public Sub XYZ()
Dim sArr, dArr, C As Object, I As Long, K As Long, R As Object, N As Long, Col As Long, Rws As Long
sArr = Sheet1.Range("A4").CurrentRegion.Value
Set C = CreateObject("Scripting.Dictionary")
Set R = CreateObject("Scripting.Dictionary")
ReDim dArr(1 To UBound(sArr), 1 To 100)
dArr(1, 1) = "Madv": dArr(1, 2) = "Mahd"
dArr(1, 3) = "Tenhd": dArr(1, 4) = "Macp": dArr(1, 5) = "Tencp"
K = 1: N = 5
For I = 2 To UBound(sArr)
    If Not C.Exists(sArr(I, 1)) Then
        N = N + 1
        C.Add sArr(I, 1), N
        dArr(1, N) = sArr(I, 1)
    End If
            If Not R.Exists(sArr(I, 3) & "#" & sArr(I, 4)) Then
                K = K + 1
                R.Add sArr(I, 3) & "#" & sArr(I, 4), K
                dArr(K, 1) = sArr(I, 2)
                dArr(K, 2) = sArr(I, 3)
                dArr(K, 3) = sArr(I, 5)
                dArr(K, 4) = sArr(I, 4)
                dArr(K, 5) = sArr(I, 6)
            End If
                Rws = R.Item(sArr(I, 3) & "#" & sArr(I, 4))
                Col = C.Item(sArr(I, 1))
                dArr(Rws, Col) = dArr(Rws, Col) + sArr(I, 7)
Next
Sheet1.Range("I4").Resize(K, 49).Value = dArr
End Sub

Cám ơn bạn, làm cách này có hơi khó tùy biến cho data sheet1 khi thay đổi , vì data của sheet1 có thể thay đổi không phải cố định như file mẫu tôi gửi , có thể có nhiều hoặc ít trường hơn, code trong file bài #1 tôi viết nó sẽ thay đổi khi data thay đổi nhưng nó quá chậm, tôi sẽ suy nghĩ chỉnh lại code của bạn để tự thay đổi khi data thay đổi.

 

[Đừng Lắm Mồm]

Cám ơn bạn, làm cách này có hơi khó tùy biến cho data sheet1 khi thay đổi , vì data của sheet1 có thể thay đổi không phải cố định như file mẫu tôi gửi , có thể có nhiều hoặc ít trường hơn, code trong file bài #1 tôi viết nó sẽ thay đổi khi data thay đổi nhưng nó quá chậm, tôi sẽ suy nghĩ chỉnh lại code của bạn để tự thay đổi khi data thay đổi.

Đừng hỏi mà hãy thử...

XYZ: cốt trên là đã động lắm rồi...

 

[excel_lv1.5]

Đừng hỏi mà hãy thử...

XYZ: cốt trên là đã động lắm rồi...

Khi xóa cột Madv bên data sheet1 , code bạn sẽ bị lỗi. Số cột của sheet data có thể thay đổi.

 

[Đừng Lắm Mồm]

Khi xóa cột Madv bên data sheet1 , code bạn sẽ bị lỗi. Số cột của sheet data có thể thay đổi.

Bạn xóa cột -> cốt lỗi -> thì điều tất nhiên...

 

[excel_lv1.5]

Bạn xóa cột -> cốt lỗi -> thì điều tất nhiên...

Thì tôi có nói là code bạn khó tùy biến khi data thay đổi mà, code có sẵn trong file bài #1 khi xóa cột code vẫn chạy bình thường (trừ cột "Nam" và "Thanhtien").

 

[be_09]

Thì tôi có nói là code bạn khó tùy biến khi data thay đổi mà, code có sẵn trong file bài #1 khi xóa cột code vẫn chạy bình thường (trừ cột "Nam" và "Thanhtien").

Thì bạn sử dụng code tự động tạo PivotTable khi thêm bất kỳ dữ liệu với 2 cột "Nam" và "Thanhtien" thôi, còn lại thao tác bằng tay thì sẽ tùy biến hơn.

 

[excel_lv1.5]

Thì bạn sử dụng code tự động tạo PivotTable khi thêm bất kỳ dữ liệu với 2 cột "Nam" và "Thanhtien" thôi, còn lại thao tác bằng tay thì sẽ tùy biến hơn.

Em muốn tạo ra báo cáo cuối cùng là cái bảng pivot đó nên dùng code toàn bộ, không làm tay. Chứ làm tay thì ngay cái data làm pivot luôn khỏi code cho khỏe, cái bảng data ở sheet1 chỉ là cái bảng trung gian để tao ra cái báo cáo pivot, nên khi ra báo cáo thì cái bảng data ở sheet1 sẽ không còn nữa, code thì đã tùy biến được nhưng quá chậm so với cách làm tay. Em đang tìm cách chỉnh lại code của anh HLMT để tùy biến khi data thay đổi.

 

[be_09]

Em muốn tạo ra báo cáo cuối cùng là cái bảng pivot đó nên dùng code toàn bộ, không làm tay. Chứ làm tay thì ngay cái data làm pivot luôn khỏi code cho khỏe, cái bảng data ở sheet1 chỉ là cái bảng trung gian để tao ra cái báo cáo pivot, nên khi ra báo cáo thì cái bảng data ở sheet1 sẽ không còn nữa, code thì đã tùy biến được nhưng quá chậm so với cách làm tay. Em đang tìm cách chỉnh lại code của anh HLMT để tùy biến khi data thay đổi.

Nếu dữ liệu quá nhiều mà làm tay thì quá chậm nên tôi mới nêu dùng 2 Field "Nam" và "Thanhtien" để tạo PivotTable, việc còn lại chỉ ứng biến Check tay thấy cũng lẹ. Ngoại trừ 2 Field vừa nêu thì bạn có thể xóa bất kỳ cột nào cũng không ảnh hưởng đến code.