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

Lequocvan · 13/2/23

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..

snow25 · 13/2/23

Lequocvan đã viết:
Em dùng filter, dữ liệu cột A đến O được xử lý và trả kết quả tại cột AH. Nhưng với số lượng cả trăm nghìn dòng 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 khi số lượng dòng rất lớn..

Lọc thế nào nói ra chứ ai lại đi đọc từng code của bạn để viết code khác.

bebo021999 · 13/2/23

Cụ thể thế nào bạn mô tả rõ hơn nhé. Filter cột nào, điểu kiện thế nào?

tranhungdao12a3 · 13/2/23

Dùng Power Pivot nhé bạn! Khi đó không cần lo về trăm ngàn hay triệu dòng!

ptm0412 · 13/2/23

Lequocvan đã viết:
Em dùng filter, dữ liệu cột A đến O được xử lý và trả kết quả tại cột AH. Nhưng với số lượng cả trăm nghìn dòng 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 khi số lượng dòng rất lớn..

Bạn nghiên cứu và sử dụng mảng thay vì làm trực tiếp trên sheet (copy paste, dùng vòng lặp, xóa, rồi copy, ...)
Tôi đọc sơ qua thì thấy code thừa rất nhiều dòng, thậm chí dư cả sub. Nếu biết mục đích cuối thì chỉ 1 sub ngắn gọn thôi.

Lequocvan · 13/2/23

ptm0412 đã viết:
Bạn nghiên cứu và sử dụng mảng thay vì làm trực tiếp trên sheet (copy paste, dùng vòng lặp, xóa, rồi copy, ...)
Tôi đọc sơ qua thì thấy code thừa rất nhiều dòng, thậm chí dư cả sub. Nếu biết mục đích cuối thì chỉ 1 sub ngắn gọn thôi.

Em rất mong Thầy giúp code ah

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

snow25 đã viết:
Lọc thế nào nói ra chứ ai lại đi đọc từng code của bạn để viết code khác.

Em dùng lọc filter như file nhưng tốc độ chậm lắm ah. Kết quả sau khi xử lý dữ liệu ban đầu (cột A:O) ở cột AX:BL ah

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

tranhungdao12a3 đã viết:
Dùng Power Pivot nhé bạn! Khi đó không cần lo về trăm ngàn hay triệu dòng!

Cách này em đã thử nhưng ko đáp ứng yêu cầu tạo ra danh sách như cột AX:BL

tranhungdao12a3 · 13/2/23

Lequocvan đã viết:
Em rất mong Thầy giúp code ah

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

Em dùng lọc filter như file nhưng tốc độ chậm lắm ah. Kết quả sau khi xử lý dữ liệu ban đầu (cột A:O) ở cột AX:BL ah

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

Cách này em đã thử nhưng ko đáp ứng yêu cầu tạo ra danh sách như cột AX:BL

Tôi nghĩ bạn áp dụng nó chưa đúng, chứ với dữ liệu của bạn nếu chỉ lọc thì Slicer của Power Pivot nó tự cắt kết quả cho bạn, thậm chí không cần phải viết hàm

ptm0412 · 13/2/23

Lequocvan đã viết:
Em rất mong Thầy giúp code ah

Bạn mong gì ở tôi nếu như tôi không biết kết quả cuối bạn cần gì? Tôi không biết và đã phải hỏi: "Nếu biết mục đích cuối thì chỉ 1 sub ngắn gọn thôi."

VetMini · 13/2/23

Làm việc vớ "số dòng rất lớn" mà không chịu cải tiến kiến thức với Power Query, Data Model là làm biếng và ỷ lại.

Lequocvan · 13/2/23

VetMini đã viết:
Làm việc vớ "số dòng rất lớn" mà không chịu cải tiến kiến thức với Power Query, Data Model là làm biếng và ỷ lại.

Đúng vậy, lý ra em cần đẩy xls, csv vào MSSQL luôn để xử lý .. nhưng em muốn chạy độc lập với riêng Excel và Dictionary ah

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

ptm0412 đã viết:
Bạn mong gì ở tôi nếu như tôi không biết kết quả cuối bạn cần gì? Tôi không biết và đã phải hỏi: "Nếu biết mục đích cuối thì chỉ 1 sub ngắn gọn thôi."

Kết quả đúng là:

A

B

cot 3

E

F

L

N

cot 1

cot 2

cot 3

cot 5

cot 6

cot 12

cot 14

575462

Donvi 1

231,656,838,000.00

9754789

Nguyen A

125,892,917,000.00

8294102

Tran B

53,052,724,000.00

8297491

Le C

1,075,000,000.00

3534762

Pham D

3,831,000,000.00

9376251

Tran C

4,948,197,000.00

575462

Cong ty 1

27,357,000,000.00

22,246,000,000.00

753840

Le Giang

10,700,000,000.00

3337090

Huyen Trang

2,300,000,000.00

9452844

Hong Nhung

2,500,000,000.00

3430335

Donvi 2

96,000,000.00

3430335

To Huyen

96,000,000.00

4119251

Donvi3

111,405,744,754.00

4119251

DN 1

111,405,744,754.00

ptm0412 · 13/2/23

Lequocvan đã viết:
Đúng ra kết quả của A:O phải là như sau ah:

Bạn không biết cách hỏi, và cả không biết cách trả lời. Hãy diễn tả bằng lời làm thế nào để ra kết quả đó, lọc thế nào, điều kiện lọc là gì, như thế nào là thỏa điều kiện.

Lequocvan · 13/2/23

ptm0412 đã viết:
Bạn không biết cách hỏi, và cả không biết cách trả lời. Hãy diễn tả bằng lời làm thế nào để ra kết quả đó, lọc thế nào, điều kiện lọc là gì, như thế nào là thỏa điều kiện.

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

Hoàng Nhật Phương · 13/2/23

Lequocvan đã viết:
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

Bạn tham khảo:

Mã:

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
                Else
                    result(r, 3) = result(r, 3) + money
                End If
            Else
                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
End Sub

ptm0412 · 13/2/23

Lequocvan đã viết:
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

Có phải như vầy không?

Hoặc như vầy

BuiQuangThuan · 13/2/23

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

Mã:

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

Lequocvan · 13/2/23

Hoàng Nhật Phương đã viết:

Bạn tham khảo:

Mã:

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
                Else
                    result(r, 3) = result(r, 3) + money
                End If
            Else
                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
End Sub

xin cảm ơn Bác, nhưng do em đặt câu hỏi kỳ cục khó diễn đạt nên kết quả muốn có phải là #10 ah
P/s: nói thiệt là nhìn logo em lại thấy như OT ấy ah!

ptm0412 đã viết:
Có phải như vầy không?

View attachment 286453

Chính xác ah, đúng là như vậy ah.
P/s: ở đơn vị cũ em vẫn bị coi là người đặt câu hỏi kỳ cục ah.

ptm0412 · 13/2/23

Lequocvan đã viết:
Chính xác ah, đúng là như vậy ah.

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

Hoàng Nhật Phương · 13/2/23

Lequocvan đã viết:
xin cảm ơn Bác, nhưng do em đặt câu hỏi kỳ cục khó diễn đạt nên kết quả muốn có phải là #10 ah
P/s: nói thiệt là nhìn logo em lại thấy như OT ấy ah!

Vâng là OT ạ, bạn tham khảo:

Mã:

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) + money
                result(k, 14) = result(k, 14) + money
                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

Lequocvan · 13/2/23

Hoàng Nhật Phương đã viết:

Vâng là OT ạ, bạn tham khảo:

Mã:

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) + money
                result(k, 14) = result(k, 14) + money
                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

Chính xác ah, một giải pháp hay. Em xin chào OT ah!

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

ptm0412 đã viết:
Pivot table, kéo thả 10 giây. Khỏi VBA

Dạ, em cảm ơn Thầy Mỹ ah

ptm0412 · 13/2/23

Hoàng Nhật Phương đã viết:
Vâng là OT ạ, bạn tham khảo:

Công ty 1 sai:

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.

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

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

File đính kèm

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

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

Thành viên tiêu biểu

Bad Excel Member

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

Thành viên tiêu biểu

Bad Excel Member

Ăn cùng góc phố

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

Bad Excel Member

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

Thành viên gắn bó

Bad Excel Member

❆❆❆❆❆❆❆❆❆❆❆❆

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

Bad Excel Member

Thành viên gắn bó

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

Bad Excel Member