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

 

[snow25]

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]

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]

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

 

[ptm0412]

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]

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

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

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]

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]

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]

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]

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

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​	125,892,917,000.00​
			8294102​	Tran B	53,052,724,000.00	53,052,724,000.00
			8297491​	Le C	1,075,000,000.00​	1,075,000,000.00​
			3534762​	Pham D	3,831,000,000.00​	3,831,000,000.00​
			9376251​	Tran C	4,948,197,000.00​	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​	10,700,000,000.00​
			3337090​	Huyen Trang	2,300,000,000.00​	2,300,000,000.00​
			9452844​	Hong Nhung	2,500,000,000.00​	2,500,000,000.00​
3430335​	Donvi 2	96,000,000.00	3430335​	To Huyen	96,000,000.00​	96,000,000.00​
4119251​	Donvi3	111,405,744,754.00	4119251​	DN 1	111,405,744,754.00​	111,405,744,754.00​

 

[ptm0412]

Đú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]

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]

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:

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]

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]

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

 

[Lequocvan]

Bạn tham khảo:

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!

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]

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]

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:

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]

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

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

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

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

 

[ptm0412]

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.