Trích lọc và liệt kê dữ liệu bằng Filter thì lâu hơn dictionary

[Lequocvan]

Em đang dùng cách Filter để xử lý dữ liệu từ cột A đến O, trả kết quả tại cột R. (code VBA của em chia nhỏ theo sub, Sub thứ 2 xử lý A:O cho ra kết quả tại cột R; Sub thứ 3 xử lý R:AF cho ra kết quả tại cột AH; Sub thứ 4 xử lý AH:AV cho ra kết quả tại AX:BL nhưng kết quả vẫn chưa đúng, đúng ra, bảng kết quả là các cột: cột 1, 2, 5, 6 (các cột này lấy giá trị duy nhất; cột 3 là tổng cộng cột 12 theo cột 1, cột 4 tổng cộng cột 14 theo cột 1; cột 7 là tổng cộng cột 12 theo cột 5, cột 8 là tổng cộng cột 14 theo cột 5).
Nhưng với cách filter này thì thực sự lâu về thời gian. Em mong các Thầy chỉ giúp em code xý lý nhanh hơn..

 

[Lequocvan]

Thêm cách khác tham khảo.Sort cột A trước khi chạy code.

Sub ABC()
    Dim Dic As Object, sArr(), Res(), i&, Key, iRow&, m&, n&, sKey
    Set Dic = CreateObject("Scripting.Dictionary")
    With Sheets("Sheet1")
        iRow = .Range("A" & Rows.Count).End(3).Row
        sArr = .Range("A2:O" & iRow).Value
        ReDim Res(1 To UBound(sArr), 1 To 7)
        For i = 1 To UBound(sArr)
            Key = Trim(sArr(i, 1))
            sKey = sArr(i, 1) & "|" & sArr(i, 5)
            If Dic.Exists(Key) = False Then
                m = m + 1
                Dic.Add (Key), m
                Res(m, 1) = Key
                Res(m, 2) = sArr(i, 2)
                Res(m, 3) = sArr(i, 14)
            Else
                Res(Dic.Item(Key), 3) = Res(Dic.Item(Key), 3) + sArr(i, 14): m = n + 1
            End If
            If Dic.Exists(sKey) = False Then
                n = n + 1
                Dic.Add (sKey), n
                Res(n, 4) = Split(sKey, "|")(1)
                Res(n, 5) = sArr(i, 6)
                Res(n, 6) = sArr(i, 12)
                Res(n, 7) = sArr(i, 14)
            Else
                Res(Dic.Item(sKey), 6) = Res(Dic.Item(sKey), 6) + sArr(i, 12)
                Res(Dic.Item(sKey), 7) = Res(Dic.Item(sKey), 7) + sArr(i, 14)
            End If
        Next
        .Range("AX2").Resize(m, 7).Value = Res
    End With
End Sub

Cảm ơn em, anh tuỳ biến thêm chút, cook code chút là ra kết quả chuẩn xác.

Bài đã được tự động gộp: 13/2/23

Công ty 1 sai:

View attachment 286455

Với lại khi đọc 4 sub loằng ngoằng tôi đã đoán rằng chỉ 1 sub ngắn gọn, thậm chí không cần code mà dùng cách khác (cụ thể là pivot table). Té ra đoán đúng.

em bị lẫn lộn, bí bách quá nên hấp tấp vội vàng ah. Em xin nhận lỗi.

 

[Hoàng Nhật Phương]

Công ty 1 sai:

View attachment 286455

Với lại khi đọc 4 sub loằng ngoằng tôi đã đoán rằng chỉ 1 sub ngắn gọn, thậm chí không cần code mà dùng cách khác (cụ thể là pivot table). Té ra đoán đúng.

À, con nhìn nhầm tưởng cột 12 và cột14 bằng nhau, vậy con chỉnh lại chút:

Option Explicit

Sub test()
    
    Dim sheet As Worksheet, rng As Range
    Dim data As Variant, origin As Variant, result As Variant
    Dim r As Long, i As Long, j As Long, k As Long, money As Double
    
    Set sheet = ThisWorkbook.Worksheets("Sheet1")
    Set rng = sheet.Range("A1").CurrentRegion
    origin = rng.Value
    rng.Sort Key1:=sheet.Range("A1"), Order1:=xlAscending, Header:=xlYes
    data = rng.Value: rng.Value = origin
    ReDim result(1 To UBound(data, 1), 1 To UBound(data, 2))
    Set rng = sheet.Range("R1"): k = 1
    If (rng.Value <> "") Then rng.CurrentRegion.Clear
    
    For i = LBound(data, 1) To UBound(data, 1)
        If (i > 1) Then
            money = data(i, 14)
            If (data(i, 5) <> data(i - 1, 5)) Then
                k = k + 1
                For j = 4 To UBound(data, 2)
                    result(k, j) = data(i, j)
                Next j
                If (data(i, 1) <> data(i - 1, 1)) Then
                    r = k
                    result(r, 1) = data(i, 1)
                    result(r, 2) = data(i, 2)
                    result(r, 3) = money
                    rng.Offset(r - 1).Resize(, 3).Font.Bold = True
                    rng.Offset(r - 1).Resize(, 3).Font.ColorIndex = 5
                    rng.Offset(r - 1).Resize(, 3).Interior.ColorIndex = 35
                    rng.Offset(r - 1, 2).NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
                Else
                    result(r, 3) = result(r, 3) + money
                End If
            Else
                result(k, 12) = result(k, 12) + data(i, 12)
                result(k, 14) = result(k, 14) + data(i, 14)
                result(r, 3) = result(r, 3) + money
            End If
        Else
            For j = LBound(data, 2) To UBound(data, 2)
                result(k, j) = data(i, j)
            Next j
        End If
    Next i
    
    With rng.Resize(k, UBound(result, 2))
        .Value = result
        .Borders.LineStyle = xlContinuous
        .Borders.Color = vbRed
        .Borders.Weight = xlThin
    End With
    rng.Offset(k, 2) = "=SUM(C[-6])=SUM(R[-11]C:R[-1]C)"
    rng.Offset(k, 2).Font.Bold = True
    rng.Offset(k, 2).Interior.ColorIndex = 35
    
End Sub

 

[VetMini]

Pivot table, kéo thả 10 giây. Khỏi VBA

Bạn viết loạt bài Power BI mà khong có đủ tin tưởng vào chúng.
Vì vậy, bạn khong để ý bài #9 của tôi nói gì.
Thớt bảo là "số dòng rất lớn". Đó là nhiệm vụ của Data Model.
Thớt muốn chuyên chở hàng, mỗi lượt hằng chục tấn mà hà tiện mua đầu máy lớn. Chỉ đi mót lại mấy cái xe heo đời cũ, miễn phí (dẫu sao thì cũng có một đống GPE sửa máy giùm)

 

[ptm0412]

Bạn viết loạt bài Power BI mà khong có đủ tin tưởng vào chúng.

Nhìn kết quả mẫu trong bài 1 và trong file, thật tình tôi không biết cái kết quả đó từ đâu ra. Câu văn thì nói cột AH, mà kết quả từa lưa từ R đến tận BL gồm 3 bảng 15 cột.

Cấu trúc thì lộn xộn, con số thì không phải sum. Thậm chí còn chưa định dạng số, cột thì nhỏ chỉ hiển thị dạng sceintific. Bố bảo tôi cũng không dám khẳng định.

 

[VetMini]

...
Cấu trúc thì lộn xộn, con số thì không phải sum. Thậm chí còn chưa định dạng số, cột thì nhỏ chỉ hiển thị dạng sceintific. Bố bảo tôi cũng không dám khẳng định.

Thế mới phải tung chiêu kinh điển của GPE "số dòng rất lớn"

 

[Lequocvan]

Nhìn kết quả mẫu trong bài 1 và trong file, thật tình tôi không biết cái kết quả đó từ đâu ra. Câu văn thì nói cột AH, mà kết quả từa lưa từ R đến tận BL gồm 3 bảng 15 cột.

Cấu trúc thì lộn xộn, con số thì không phải sum. Thậm chí còn chưa định dạng số, cột thì nhỏ chỉ hiển thị dạng sceintific. Bố bảo tôi cũng không dám khẳng định.

Dạ, em xin nhận lỗi. Bài đầu là em mô tả diễn giải từng sub nhỏ đến tật cột AX:BL nhưng vẫn chưa chuẩn xác.
Đúng như @VetMini nói là phải Data Model, PowerBI nhưng có những lỗi khổ nho nhỏ em biết làm sao đây..

 

[ptm0412]

em bị lẫn lộn, bí bách quá nên hấp tấp vội vàng ah. Em xin nhận lỗi.

Hãy đọc bài này và suy gẫm:

Một vấn đề lớn đó là cách hỏi, phương pháp hỏi.
Thí dụ
Cách hỏi 1:
Tôi có 4 textbox trên form Excel, textbox1 sẽ điền ngày tháng, textbox2 điền số ngày, textbox3 điền số ngày cộng thêm, tôi muốn khi điền 3 textbox đó thì textbox4 sẽ tính bằng textbox1 + textbox2 + textbox3. Khi nhấn 1 nút nhấn thì lưu dữ liệu xuống sheet 1 ở cột A, B, C, D
Cách hỏi 2:
Tôi có 1 userform trong excel, trên đó có 4 textbox có tên txtNgaydau chứa dữ liệu dạng ngày tháng, txtNgay và txtNgayThem có dạng số và txtNgayCuoi có dạng ngày tháng. Tôi muốn khi điền ngày tháng vào txtNgaydau định dang dd/mm/yyyy, số ngày vào txtNgay, số ngày cộng thêm vào txtNgayThem thì txtNgayCuoi tự tính ngày cuối bằng 3 textbox kia cộng lại. Ghi chú là txtNgayThem có quyền bỏ trống, và txtNgayCuoi là ngày tháng có dạng dd/mm/yyyy. Tôi cũng không muốn mỗi khi gõ 1 ký tự là code tính một lần, gây chậm chạp, máy tôi yếu. Sau đó tôi muốn 1 nút nhấn thực hiện việc ghi tuần tự giá trị 4 textbox xuống dòng tiếp theo của bảng dữ liệu có sẵn trên sheet có tên Data từ cột A đến cột D, đúng định dạng như textbox. Hãy giúp tôi viết code VBA cho yêu cầu trên.

Các bạn thử hỏi GPT đi, xem code trả lời cách hỏi nào hiệu quả hơn.

 

[VetMini]

Hãy đọc bài này và suy gẫm:

[ChatGPT] Chia Sẻ Kinh Nghiệm - Hỏi ChatGPT Hổ Trợ Lập Trình VBA

Một vấn đề lớn đó là cách hỏi, phương pháp hỏi. Thí dụ Cách hỏi 1: Tôi có 4 textbox trên form Excel, textbox1 sẽ điền ngày tháng, textbox2 điền số ngày, textbox3 điền số ngày cộng thêm, tôi muốn khi điền 3 textbox đó thì textbox4 sẽ tính bằng textbox1 + textbox2 + textbox3. Khi nhấn 1 nút nhấn...

www.giaiphapexcel.com

Thớt biết cách hỏi chứ. Rõ ràng là biết giật gân bài bằng cái tiêu đề lúc đàu "số dòng rất lớn".
Khi thấy nói không cần VBA cũng làm được thì đổi thành so sánh code Đít sần. Rõ ràng là thớt biết cách dụ bà con chú trọng vào VBA thay vì các thủ thuật khác.

Thớt còn biết hơn bạn ở chỗ: trên GPE này, câu hỏi không cần rõ ràng, chỉ cần có người chịu code rồi thì trướ thành gân gà, lỡ code rồi mà bỏ thì sợ bị chế ngu.
Sau vài lượt đoán qua đoán lại, người code sẽ đoán ra yêu cầu chính thức.

 

[Lequocvan]

Thớt biết cách hỏi chứ. Rõ ràng là biết giật gân bài bằng cái tiêu đề lúc đàu "số dòng rất lớn".
Khi thấy nói không cần VBA cũng làm được thì đổi thành so sánh code Đít sần. Rõ ràng là thớt biết cách dụ bà con chú trọng vào VBA thay vì các thủ thuật khác.

Thớt còn biết hơn bạn ở chỗ: trên GPE này, câu hỏi không cần rõ ràng, chỉ cần có người chịu code rồi thì trướ thành gân gà, lỡ code rồi mà bỏ thì sợ bị chế ngu.
Sau vài lượt đoán qua đoán lại, người code sẽ đoán ra yêu cầu chính thức.

Dạ, đúng là tại em hỏi câu hỏi không rõ ràng, diễn đạt chưa chi tiết ah..

Bài đã được tự động gộp: 14/2/23

Em đã làm với Pivottable: Rows thì em nhấc thả cột 1, 2, 5, 6; Values thì em nhấc thả cột 12 (sum), 14 (sum)
Chuyển đến Design Pivottable, tính năng Report Layout em chọn mục Show in Tabular Form.
Chuột phải cột 2, bỏ chọn Subtotal "cot 2"
Chuột phải cột 5, bỏ chọn Subtotal "cot 5"
Và đây là kết quả như Thầy Mỹ đã nói:

 

[HUONGHCKT]

Em lọc cột A lấy giá trị duy nhất, cộng tổng cột 12, cột 14 theo giá trị duy nhất
Với mỗi giá trị duy nhất từ A, liệt kê duy nhất cột E, cột F.
cột kế tiếp là cộng tổng theo giá trị duy nhất cột E ah

Thêm 1 cách để bạn tham khảo:
Tôi đoám mò thế này không biết đúng ý không:

lọc cột A lấy giá trị duy nhất, cộng tổng cột 12, cột 14 theo giá trị duy nhất

Tạm gọi là dòng tổng của giá trị duy nhất ấy: -do vậy dòng này chỉ gồm Cột A, cột 12 (tổng cộng), và cột 14( cộng dồn)
" Với mỗi giá trị duy nhất từ A, liệt kê duy nhất cột E, cột F."
Tiếp theo là lấy Mã duy nhất của cột A với Cột 5( cột 5) để làm key để tổng hợp theo key ấy và ghi vào các dòng tiếp theo sau dòng tổng cộng (như là phân tích phần tổng cộng gồm những ai, bao nhiêu...)

Option Explicit

Sub Loc()
Dim i&, j&, Lr&, R&, C&, t&, k&, z&, x&, L&, m&
Dim Arr(), KQ(), S, Luot(), LuotNguoi()
Dim Dic As Object, DicSDT As Object, Key, Temp
With Sheet1
Lr = .Cells(Rows.Count, 1).End(xlUp).Row
Arr = .Range("A2:O" & Lr).Value
R = UBound(Arr): C = UBound(Arr, 2)
ReDim KQ(1 To R * 2, 1 To C)
ReDim Luot(1 To R, 1 To 1)
ReDim LuotNguoi(1 To R, 1 To 1)
Set Dic = CreateObject("Scripting.Dictionary")
Set DicSDT = CreateObject("Scripting.Dictionary")
For i = 1 To R
    Key = Arr(i, 1): Temp = Arr(i, 1) & "#" & Arr(i, 5): t = z
    If Not Dic.exists(Key) Then
        t = t + 1: Dic.Add (Key), t: L = 0
        KQ(t, 1) = Key: KQ(t, 12) = Arr(i, 12): KQ(i, 14) = Arr(i, 14)
        LuotNguoi(t, 1) = 1: KQ(t, 3) = " Sô ngươi: " & LuotNguoi(t, 1)
    Else
        k = Dic.Item(Key)
        KQ(k, 12) = KQ(k, 12) + Arr(i, 12): KQ(k, 14) = KQ(k, 14) + Arr(i, 14)
        LuotNguoi(k, 1) = LuotNguoi(k, 1) + 1
        KQ(k, 3) = " Sô ngươi: " & LuotNguoi(k, 1)
    End If

    If Not DicSDT.exists(Temp) Then
         z = t: z = z + 1: DicSDT.Add (Temp), z
        For j = 5 To C
            KQ(z, j) = Arr(i, j)
        Next j
            Luot(z, 1) = 1: KQ(z, 3) = "Sô luot nguoi: " & Luot(z, 1)
    Else
        x = DicSDT.Item(Temp):
        Luot(x, 1) = Luot(x, 1) + 1
            KQ(x, 3) = "Sô luot nguoi: " & Luot(x, 1)
        KQ(x, 4) = KQ(x, 4) + Arr(i, 4): KQ(x, 9) = KQ(x, 9) + Arr(i, 9):
        KQ(x, 12) = KQ(x, 12) + Arr(i, 12): KQ(x, 14) = KQ(x, 14) + Arr(i, 14)
    End If
Next i
Set Dic = Nothing
.Range("R75").Resize(1000, C).ClearContents
.Range("R75").Resize(R, C) = KQ
End With
MsgBox "Done"
End Sub

Xem file. nhấn Run code để xem kết quả.

 

[HieuCD]

Các code trên dựa trên giả định những mã giống nhau cột 5 xếp liên tiếp, nếu có anh nào đi lạc sẽ có kết quả sai, ví dụ thêm dòng cuối "9754789" ( Nguyen A)

 

[HUONGHCKT]

Các code trên dựa trên giả định những mã giống nhau cột 5 xếp liên tiếp, nếu có anh nào đi lạc sẽ có kết quả sai, ví dụ thêm dòng cuối "9754789" ( Nguyen A)

Đã phát hiện chỗ sai và sửa lại.
Trân trọng cảm ơn anh @HieuCD !

 

[tranhungdao12a3]

Khả năng diễn diễn đạt của bạn làm người khác hoang mang,
Như tôi đã nói dữ liệu của bạn lớn thì bạn nên dùng Data Model. Tôi gợi ý bạn dùng hàm để trích ra Tổng theo cột 2 như ý bạn, như vậy bạn có thể tùy biến, tính tỷ lệ đóng góp, trích ra vấn đề cột 6,...Những yêu cầu thực tế mà Pivot sẽ không giải quyết được.