Nhờ hướng dẫn tổng hợp dữ liệu bằng VBA dạng mảng (2 người xem)

[ngoc0977760224]

Mình tổng hợp theo phương pháp bỏ trùng và sumif, nhưng khi dữ liệu mấy nghìn dòng thì bị chạy rất lâu. Nhờ các bạn tổng hợp giúp mình dạng mảng cho nó xử lý nhanh hơn giúp. Dữ liệu chi tiết ở sheet "du lieu chi tiết": gồm 6 điều kiện và 10 cột cần cộng tổng. Kết quả cho ra ở sheet "bang tong hop".

 

[Hoàng Tuấn 868]

Nhờ hướng dẫn tổng hợp dữ liệu bằng VBA dạng mảng​

Mình tổng hợp theo phương pháp bỏ trùng và sumif,

Bạn muốn hướng dẫn bằng VBA thì bạn viết code VBA trước đi, vướng chỗ nào thì hỏi các thành viên sẽ hướng dẫn chỗ đó.

 

[ptm0412]

Hướng dẫn từ đầu:
- Khai báo biến mảng nguồn và mảng kết quả
- Tạo 1 Dictionary
- Gán từng phần tử cho Dict bằng giá trị là nối 6 cột phân loại, item là số thứ tự gán
- Redim mảng kết quả với số dòng là số lượng phần tử của Dict
- Duyệt mảng nguồn. Mỗi dòng của mảng nguồn nối 6 cột phân loại, so sánh với Dict để lấy item
- Tại dòng item, gắn 6 cột đầu bằng 6 phân loại, các cột sau thì cộng dồn vào giá trị trước đó
- Gán giá trị mảng kết quả xuống

Mặc dù vậy, loại tổng hợp này dùng Pivot table là xong ngay. Viết code lâu hơn.

 

[tranquoctoan.nuce]

bạn có thể xem mẫu code mình viết này để áp dụng sang cho mình nhé, refresh 1 và refresh 2

 

[bebo021999]

Dùng code này thử xem nhé

Option Explicit
Sub tonghop()
Dim i&, j&, k&, rng, res(), st$, s, ar(1 To 10)
Dim dic As Object, key
Set dic = CreateObject("Scripting.Dictionary")
With Sheets("DU LIEU CHI TIET")
    rng = .Range("A1").CurrentRegion.Value
End With
For i = 2 To UBound(rng)
    st = rng(i, 1) & "|" & rng(i, 2) & "|" & rng(i, 3) & "|" & rng(i, 4) & "|" & rng(i, 5) & "|" & rng(i, 6)
    If Not dic.exists(st) Then
        For j = 1 To 10
            ar(j) = rng(i, 6 + j)
        Next
        dic.Add st, Join(ar, "|")
    Else
        s = Split(dic(st), "|")
        For j = 1 To 10
            ar(j) = s(j - 1) + rng(i, 6 + j)
        Next
        dic(st) = Join(ar, "|")
    End If
Next
ReDim res(1 To dic.Count, 1 To 16)
With Sheets("BANG TONG HOP")
    For Each key In dic.keys
        k = k + 1
        For j = 1 To 16
            If j <= 6 Then
                res(k, j) = Split(key, "|")(j - 1)
            Else
                res(k, j) = Split(dic(key), "|")(j - 7)
            End If
        Next
    Next
.Range("A2:P100000").ClearContents
.Range("A2").Resize(UBound(res), 16).Value = res
End With
End Sub

 

[ptm0412]

Code này chỉ 1 vòng lặp

Sub TongHop()
Dim SArr(), RArr()
Dim Dict, Key1 As String, LastRw As Long
Set Dict = CreateObject("Scripting.Dictionary")
LastRw = Sheet1.[A500000].End(xlUp).Row
SArr = Sheet1.Range("A2:P" & LastRw).Value
ReDim RArr(1 To 1000, 1 To 16)
For i = 1 To UBound(SArr, 1)
    Key1 = SArr(i, 1) & SArr(i, 2) & SArr(i, 3) & SArr(i, 4) & SArr(i, 5) & SArr(i, 6)
    If Not Dict.exists(Key1) Then
        k = k + 1
        Dict.Add Key1, k
        For j = 1 To 16
            RArr(k, j) = SArr(i, j)
        Next
    Else
        n = Dict.Item(Key1)
        For j = 7 To 16
            RArr(n, j) = RArr(n, j) + SArr(i, j)
        Next
    End If
Next
Sheet2.Range("S2:AH1000").Clear
Sheet2.Range("S2").Resize(k, 16).Value = RArr

End Sub

 

[SA_DQ]

@Chủ bài đăng:
Nếu là mình thì sẽ gán & xài mã phân loại trong trang tính; Ví dụ: