Lộc Dữ liệu theo điều kiện và hiển thị top 5 (3 người xem)

minhhaioh34 · 19/4/23

Hiện mình có 1 file excel có 2 sheet.
Sheet Raw data: Sheet này chứa dữ liệu cần lấy
Sheet Top Section: Sheet này hiển thị dữ liệu theo yêu cầu.
- Cần lấy dữ liệu điều kiên theo ngày thắng năm ( Từ B1 đến C1 sheets Top section).
- Cần lấy dữ liệu có tên trùng với B5, B6,B7,B7,B9 ( sheet Top section)
- Tính tổng các lỗi ( cột H Total defect ) dựa theo từng loại lỗi ( Cột F category) bên sheet Raw data và sắp xếp theo thứ tự giảm dần theo top 5
Hiện mình chưa suy nghỉ ra công thức và cách giải quyết nhờ các bạn hỗ trợ giúp.
Thanks

Thóc Sama · 19/4/23

minhhaioh34 đã viết:
Hiện mình có 1 file excel có 2 sheet.
Sheet Raw data: Sheet này chứa dữ liệu cần lấy
Sheet Top Section: Sheet này hiển thị dữ liệu theo yêu cầu.
- Cần lấy dữ liệu điều kiên theo ngày thắng năm ( Từ B1 đến C1 sheets Top section).
- Cần lấy dữ liệu có tên trùng với B5, B6,B7,B7,B9 ( sheet Top section)
- Tính tổng các lỗi ( cột H Total defect ) dựa theo từng loại lỗi ( Cột F category) bên sheet Raw data và sắp xếp theo thứ tự giảm dần theo top 5
Hiện mình chưa suy nghỉ ra công thức và cách giải quyết nhờ các bạn hỗ trợ giúp.
Thanks

Cột bạn đang để là Date đó thì kết quả mong muốn sẽ là gì?

minhhaioh34 · 20/4/23

THÓC SAMA đã viết:
Cột bạn đang để là Date đó thì kết quả mong muốn sẽ là gì?

Cột này mình định hiển thì ngày nhưng ko cần nũa vì khi sum lại thì không thể lấy chính xác ngày được giờ chỉnh cần hiển thị top 5 tổng tất cả các lỗi theo từng loại

Thóc Sama · 20/4/23

minhhaioh34 đã viết:
Cột này mình định hiển thì ngày nhưng ko cần nũa vì khi sum lại thì không thể lấy chính xác ngày được giờ chỉnh cần hiển thị top 5 tổng tất cả các lỗi theo từng loại

Bạn chạy thử code sau và kiểm tra lại kết quả xem nha!

Mã:

Option Explicit
Sub GPE()
    Dim Dic As Object, Key, i&, Lr&, j&
    Dim Smt$, Arr(), k&, DatF&, DatT&, a%
    Dim item, Res(), Temp1, Temp2
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.Calculation = False
    With Sheets("Top Section")
        DatF = CLng(.Range("B1").Value)
        DatT = CLng(.Range("C1").Value)
        Smt = UCase(.Range("B5").Value)
    End With
    Set Dic = CreateObject("Scripting.Dictionary")
    With Sheets("Raw Data")
        Lr = .Range("E" & Rows.Count).End(xlUp).Row
        Arr = .Range("A2:K" & Lr).Value
        For i = 1 To UBound(Arr)
            If CLng(Arr(i, 2)) >= DatF Then
                If CLng(Arr(i, 2)) <= DatT Then
                    If UCase(Arr(i, 5)) = Smt Then
                        Key = Arr(i, 6)
                        If Not Dic.exists(Key) Then
                            Dic.Add (Key), Arr(i, 8)
                        Else
                            Dic.item(Key) = Dic.item(Key) + Arr(i, 8)
                        End If
                    End If
                End If
            End If
        Next i
    End With
    a = Dic.Count: k = 1
    ReDim Res(1 To a, 1 To 3)
    For Each Key In Dic.keys
        Res(k, 1) = Key: Res(k, 3) = Dic.item(Key)
        k = k + 1
    Next Key
    For i = 1 To UBound(Res) - 1
        For j = i + 1 To UBound(Res)
            If Res(j, 3) > Res(i, 3) Then
                Temp1 = Res(i, 1)
                Temp2 = Res(i, 3)
                Res(i, 1) = Res(j, 1)
                Res(i, 3) = Res(j, 3)
                Res(j, 1) = Temp1
                Res(j, 3) = Temp2
            End If
        Next j
    Next i
    With Sheets("Top Section")
        .Range("C5:E9").ClearContents
        .Range("C5").Resize(IIf(a >= 5, 5, a), 3).Value = Res
    End With
    MsgBox "Done"
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Set Dic = Nothing
End Sub

minhhaioh34 · 21/4/23

THÓC SAMA đã viết:

Bạn chạy thử code sau và kiểm tra lại kết quả xem nha!

Mã:

Option Explicit
Sub GPE()
    Dim Dic As Object, Key, i&, Lr&, j&
    Dim Smt$, Arr(), k&, DatF&, DatT&, a%
    Dim item, Res(), Temp1, Temp2
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.Calculation = False
    With Sheets("Top Section")
        DatF = CLng(.Range("B1").Value)
        DatT = CLng(.Range("C1").Value)
        Smt = UCase(.Range("B5").Value)
    End With
    Set Dic = CreateObject("Scripting.Dictionary")
    With Sheets("Raw Data")
        Lr = .Range("E" & Rows.Count).End(xlUp).Row
        Arr = .Range("A2:K" & Lr).Value
        For i = 1 To UBound(Arr)
            If CLng(Arr(i, 2)) >= DatF Then
                If CLng(Arr(i, 2)) <= DatT Then
                    If UCase(Arr(i, 5)) = Smt Then
                        Key = Arr(i, 6)
                        If Not Dic.exists(Key) Then
                            Dic.Add (Key), Arr(i, 8)
                        Else
                            Dic.item(Key) = Dic.item(Key) + Arr(i, 8)
                        End If
                    End If
                End If
            End If
        Next i
    End With
    a = Dic.Count: k = 1
    ReDim Res(1 To a, 1 To 3)
    For Each Key In Dic.keys
        Res(k, 1) = Key: Res(k, 3) = Dic.item(Key)
        k = k + 1
    Next Key
    For i = 1 To UBound(Res) - 1
        For j = i + 1 To UBound(Res)
            If Res(j, 3) > Res(i, 3) Then
                Temp1 = Res(i, 1)
                Temp2 = Res(i, 3)
                Res(i, 1) = Res(j, 1)
                Res(i, 3) = Res(j, 3)
                Res(j, 1) = Temp1
                Res(j, 3) = Temp2
            End If
        Next j
    Next i
    With Sheets("Top Section")
        .Range("C5:E9").ClearContents
        .Range("C5").Resize(IIf(a >= 5, 5, a), 3).Value = Res
    End With
    MsgBox "Done"
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Set Dic = Nothing
End Sub

Thanks bạn hiện mình dùng Pivot table thì OK rồi.

BuiQuangThuan · 21/4/23

minhhaioh34 đã viết:
Thanks bạn hiện mình dùng Pivot table thì OK rồi.

Buồn nhỉ. Cả 1 đoạn code dài thế kia. Câu trả lời làm ta hụt hẫng luôn. Thôi giải quyết được rồi là được rồi

Thóc Sama · 21/4/23

BuiQuangThuan đã viết:
Buồn nhỉ. Cả 1 đoạn code dài thế kia. Câu trả lời làm ta hụt hẫng luôn. Thôi giải quyết được rồi là được rồi

Công nhận luôn, nhưng không sao.
Thớt không dùng tới, nhưng có thể người khác lại cần thì sao!!

Hoàng Tuấn 868 · 21/4/23

BuiQuangThuan đã viết:
Buồn nhỉ. Cả 1 đoạn code dài thế kia. Câu trả lời làm ta hụt hẫng luôn. Thôi giải quyết được rồi là được rồi

Khả năng là lần sau nếu nhìn thấy tên đại diện này có lẽ tránh sang một bên.

Lộc Dữ liệu theo điều kiện và hiển thị top 5 (3 người xem)

Người dùng đang xem chủ đề này

minhhaioh34

Thành viên mới

File đính kèm

Thóc Sama

＿/＿/＿/＿/＿/＿/＿/

minhhaioh34

Thành viên mới

Thóc Sama

＿/＿/＿/＿/＿/＿/＿/

minhhaioh34

Thành viên mới

BuiQuangThuan

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

Thóc Sama

＿/＿/＿/＿/＿/＿/＿/

Hoàng Tuấn 868

Đăng ký hôm qua

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian