Tính top % theo nhiều điều kiện

Liên hệ QC
L

longcin11

Thành viên mới
Tham gia
27/12/14
Bài viết
15
Được thích
0
Chào cả nhà, Mọi người giúp em tính top % theo như bên dười ( em làm bằng tay tốn thời gian quá)
Chia outlet thành 4 nhóm theo từng area:
Top 10%: 10% những outlet có Total volume cao nhất của mỗi area
Top 20%: 20% những outlet có Total volume cao thứ 2 của mỗi area
Top 30%: 30% những outlet có Total volume cao thứ 3 của mỗi area
Top 40%: 40% những outlet có Total volume thấp nhất của mỗi area
Data như file đính kèm.

Cảm ơn mọi người
 

File đính kèm

  • Top Outlet 31.12.2018.xlsb
    1.6 MB · Đọc: 10
longcin11 đã viết:
Chào cả nhà, Mọi người giúp em tính top % theo như bên dười ( em làm bằng tay tốn thời gian quá)
Chia outlet thành 4 nhóm theo từng area:
Top 10%: 10% những outlet có Total volume cao nhất của mỗi area
Top 20%: 20% những outlet có Total volume cao thứ 2 của mỗi area
Top 30%: 30% những outlet có Total volume cao thứ 3 của mỗi area
Top 40%: 40% những outlet có Total volume thấp nhất của mỗi area
Data như file đính kèm.

Cảm ơn mọi người
Nhấp chuột vào đây để mở rộng...
Điều kiện của bạn lạ nhỉ.

214437
 
tieuthubuongbinh đã viết:
Điều kiện của bạn lạ nhỉ.

View attachment 214437
Nhấp chuột vào đây để mở rộng...
Hì, mình chỉ lấy ra 1 ít data để làm ví dụ nên phép tính ở top % nó bị sai :). Cảm ơn bạn đã quan tâm đến bài viết.
Bài đã được tự động gộp:

dazkangel đã viết:
Thử:
Mã: 
=MATCH(SUMIF(D$2:D$6,D2,E$2:E$6),INDEX(AGGREGATE(14,6,SUMIF(D$2:D$6,D$2:D$6,E$2:E$6)/(COUNTIF(OFFSET(D$2,,,ROW(D$2:D$6)-1),D$2:D$6)=1),ROW($1:$4)),),0)/10
[/QUOTE/]
Dear,
Công thức này khi áp dụng đối với data số lượng ít thì nó chạy tốt, nhưng data của mình lên đến hơn 100000 dòng thì nó lại gặp vấn đề. Bạn có cách nào để nó chạy nhanh hơn đối với điều kiện như trên cho 1 file với nhiều data không?

Cảm ơn trước ạ.
Nhấp chuột vào đây để mở rộng...
 
Lần chỉnh sửa cuối:
longcin11 đã viết:
Hì, mình chỉ lấy ra 1 ít data để làm ví dụ nên phép tính ở top % nó bị sai :). Cảm ơn bạn đã quan tâm đến bài viết.
Bài đã được tự động gộp:
Nhấp chuột vào đây để mở rộng...
Bạn gửi file mẫu dữ liệu lớn lên thử xem, để mình nghĩ thêm cách giải quyết.
 
Dữ liệu quá lớn, bạn nên nhờ các thành viên viết bằng VBA thôi.
 
Có phải kết quả như bạn mong muốn ở sheet5 hay không? đọc đi đọc lại vẫn chưa hiểu, bạn có thể cho ra một đáp số mẫu nào đó không? tôi sẽ code giúp bạn
 
Lần chỉnh sửa cuối:
Chạy code
Mã: 
Sub Ranking()
  Dim sArr(), Res(), Dic As Object, tArr()
  Dim ikey, Total, tmp
  Dim i As Long, j As Long, sRow As Long, n As Long, iMin As Long, iMax As Long, S As Long
  With Sheets("Sheet1")
    i = .Range("E1000000").End(xlUp).Row
    iMin = Application.Min(.Range("E2:E" & i))
    iMax = Application.Max(.Range("E2:E" & i))
    sArr = .Range("D2:E" & i).Value
    sRow = UBound(sArr)
  End With
  ReDim Res(1 To sRow, 1 To 2)
  Set Dic = CreateObject("scripting.dictionary")

  For i = 1 To sRow
    ikey = sArr(i, 1)
    If Len(ikey) > 0 And Len(sArr(i, 2)) > 0 Then
      If Dic.exists(ikey) = False Then
        Dic.Add ikey, ""
        ReDim tArr(iMin To iMax, 1 To 2)
        n = -1
        For j = i To sRow
          Total = sArr(j, 2)
          If Len(Total) > 0 Then
            tArr(Total, 1) = tArr(Total, 1) + 1
            n = n + 1
          End If
        Next j
        S = 0
        For j = iMin To iMax
          If Len(tArr(j, 1)) > 0 Then
            tArr(j, 2) = S / n
            S = S + tArr(j, 1)
          End If
        Next j
        For j = i To sRow
          If ikey = sArr(j, 1) Then
            tmp = tArr(sArr(j, 2), 2)
            Res(j, 1) = tmp
            If tmp >= 0.9 Then
              Res(j, 2) = "Top 10%"
            ElseIf tmp >= 0.8 Then
              Res(j, 2) = "Top 20%"
            ElseIf tmp >= 0.7 Then
              Res(j, 2) = "Top 30%"
            Else
              Res(j, 2) = "Top 40%"
            End If
          End If
        Next j
      End If
    End If
  Next i
  Sheets("Sheet1").Range("H2:I2").Resize(sRow) = Res
End Sub
 

File đính kèm

  • Ranking top.xlsb
    2.6 MB · Đọc: 20
phihndhsp đã viết:
Có phải kết quả như bạn mong muốn ở sheet5 hay không? đọc đi đọc lại vẫn chưa hiểu, bạn có thể cho ra một đáp số mẫu nào đó không? tôi sẽ code giúp bạn
Nhấp chuột vào đây để mở rộng...
Sheet 5 là sau khi mình làm bằng tay xong chạy ra để kiểm tra lại kết quả cuối cùng ở cột top bên kia có thỏa điều kiện không đó bạn. Kết quả mong muốn cuối cùng của mình là chạy ra kết quả ở cột Top ( cột I) thì chạy pivot kiểm tra kết quả bằng với con số 10%, 20%, 30%, 40%.

Thanks
 
Lần chỉnh sửa cuối:
HieuCD đã viết:
Chạy code
Mã: 
Sub Ranking()
  Dim sArr(), Res(), Dic As Object, tArr()
  Dim ikey, Total, tmp
  Dim i As Long, j As Long, sRow As Long, n As Long, iMin As Long, iMax As Long, S As Long
  With Sheets("Sheet1")
    i = .Range("E1000000").End(xlUp).Row
    iMin = Application.Min(.Range("E2:E" & i))
    iMax = Application.Max(.Range("E2:E" & i))
    sArr = .Range("D2:E" & i).Value
    sRow = UBound(sArr)
  End With
  ReDim Res(1 To sRow, 1 To 2)
  Set Dic = CreateObject("scripting.dictionary")

  For i = 1 To sRow
    ikey = sArr(i, 1)
    If Len(ikey) > 0 And Len(sArr(i, 2)) > 0 Then
      If Dic.exists(ikey) = False Then
        Dic.Add ikey, ""
        ReDim tArr(iMin To iMax, 1 To 2)
        n = -1
        For j = i To sRow
          Total = sArr(j, 2)
          If Len(Total) > 0 Then
            tArr(Total, 1) = tArr(Total, 1) + 1
            n = n + 1
          End If
        Next j
        S = 0
        For j = iMin To iMax
          If Len(tArr(j, 1)) > 0 Then
            tArr(j, 2) = S / n
            S = S + tArr(j, 1)
          End If
        Next j
        For j = i To sRow
          If ikey = sArr(j, 1) Then
            tmp = tArr(sArr(j, 2), 2)
            Res(j, 1) = tmp
            If tmp >= 0.9 Then
              Res(j, 2) = "Top 10%"
            ElseIf tmp >= 0.8 Then
              Res(j, 2) = "Top 20%"
            ElseIf tmp >= 0.7 Then
              Res(j, 2) = "Top 30%"
            Else
              Res(j, 2) = "Top 40%"
            End If
          End If
        Next j
      End If
    End If
  Next i
  Sheets("Sheet1").Range("H2:I2").Resize(sRow) = Res
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn bác đã làm giúp mình file này.

Nhưng mình chạy test lại thì nó vẫn còn bị 1 số chổ chưa được như yêu cầu trên.
Mình không hiểu về VBA lắm nhưng mình thấy chổ chia top % nó trong đoạn code trên hình như chưa đúng với điều kiện lắm. MÌnh muốn là lấy top % theo total của Area thí dụ như:

Area

Number of Store Top 10%

Number of Store Top 20%

Number of StoreTop 30%

Number of StoreTop 40%

Grand Total

% of 10%

% of 20%

% of 30%

% of 40%

C8

1

2

3

4

10

10%

20%

30%

40%

Bạn có thể sửa lại giúp mình được không.
Trân trọng cảm ơn ạ.
 
longcin11 đã viết:
Cảm ơn bác đã làm giúp mình file này.

Nhưng mình chạy test lại thì nó vẫn còn bị 1 số chổ chưa được như yêu cầu trên.
Mình không hiểu về VBA lắm nhưng mình thấy chổ chia top % nó trong đoạn code trên hình như chưa đúng với điều kiện lắm. MÌnh muốn là lấy top % theo total của Area thí dụ như:

Area

Number of Store Top 10%

Number of Store Top 20%

Number of StoreTop 30%

Number of StoreTop 40%

Grand Total

% of 10%

% of 20%

% of 30%

% of 40%

C8

1

2

3

4

10

10%

20%

30%

40%
Bạn có thể sửa lại giúp mình được không.


Trân trọng cảm ơn ạ.
Nhấp chuột vào đây để mở rộng...
Chỉnh lại code
Mã: 
Sub Ranking()
  Dim sArr(), Res(), Dic As Object, Arr(), tArr()
  Dim iKey, tmp
  Dim i As Long, k As Long, sRow As Long, n As Long

  With Sheets("Sheet1")
    sArr = .Range("D2:E" & .Range("E1000000").End(xlUp).Row).Value
    sRow = UBound(sArr)
  End With
  ReDim Res(1 To sRow, 1 To 2)
  ReDim tArr(1 To sRow)
  Set Dic = CreateObject("scripting.dictionary")

  For i = 1 To sRow
    iKey = sArr(i, 1)
    If Len(iKey) > 0 And Len(sArr(i, 2)) > 0 Then
      If Dic.exists(iKey) = False Then
        Dic.Add iKey, ""
        k = 0
        For n = i To sRow
          If iKey = sArr(n, 1) And Len(sArr(n, 2)) > 0 Then
            k = k + 1
            ReDim Preserve Arr(1 To k)
            Arr(k) = sArr(n, 2)
            tArr(k) = n
          End If
        Next n
        For n = 1 To k
          Res(tArr(n), 1) = Application.PercentRank(Arr, Arr(n))
        Next n
      End If
    End If
  Next i

  For i = 1 To sRow
    tmp = Res(i, 1)
    If Len(tmp) > 0 Then
      If tmp >= 0.9 Then
        Res(i, 2) = "Top 10%"
      ElseIf tmp >= 0.8 Then
        Res(i, 2) = "Top 20%"
      ElseIf tmp >= 0.7 Then
        Res(i, 2) = "Top 30%"
      Else
        Res(i, 2) = "Top 40%"
      End If
    End If
  Next i
  Sheets("Sheet1").Range("H2:I2").Resize(sRow) = Res
End Sub
 
Lần chỉnh sửa cuối:
HieuCD đã viết:
Chỉnh lại code
Mã: 
Sub Ranking()
  Dim sArr(), Res(), Dic As Object, Arr(), tArr()
  Dim iKey, tmp
  Dim i As Long, k As Long, sRow As Long, n As Long

  With Sheets("Sheet1")
    sArr = .Range("D2:E" & .Range("E1000000").End(xlUp).Row).Value
    sRow = UBound(sArr)
  End With
  ReDim Res(1 To sRow, 1 To 2)
  ReDim tArr(1 To sRow)
  Set Dic = CreateObject("scripting.dictionary")

  For i = 1 To sRow
    iKey = sArr(i, 1)
    If Len(iKey) > 0 And Len(sArr(i, 2)) > 0 Then
      If Dic.exists(iKey) = False Then
        Dic.Add iKey, ""
        k = 0
        For n = i To sRow
          If iKey = sArr(n, 1) And Len(sArr(n, 2)) > 0 Then
            k = k + 1
            ReDim Preserve Arr(1 To k)
            Arr(k) = sArr(n, 2)
            tArr(k) = n
          End If
        Next n
        For n = 1 To k
          Res(tArr(n), 1) = Application.PercentRank(Arr, Arr(n))
        Next n
      End If
    End If
  Next i

  For i = 1 To sRow
    tmp = Res(i, 1)
    If Len(tmp) > 0 Then
      If tmp >= 0.9 Then
        Res(i, 2) = "Top 10%"
      ElseIf tmp >= 0.8 Then
        Res(i, 2) = "Top 20%"
      ElseIf tmp >= 0.7 Then
        Res(i, 2) = "Top 30%"
      Else
        Res(i, 2) = "Top 40%"
      End If
    End If
  Next i
  Sheets("Sheet1").Range("H2:I2").Resize(sRow) = Res
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn bác, em làm được rồi ạ :)
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

H
  • Question
nhờ các bác viết mẫu cho em lệnh dùng checkbox để rút ngắn thời gian thao tác
Trả lời
15
Đọc
319
hiv174
H
kiencuong030184
  • Question
Nhờ giúp đỡ về ẩn dòng, cột có điều kiện
Trả lời
1
Đọc
34
BuiQuangThuan
B
T
V/v tối ưu xử lý đoạn code
Trả lời
1
Đọc
45
SA_DQ
SA_DQ
kiet317
Helloooooooooooo
    • Phẫn nộ
    • Buồn
Trả lời
1
Đọc
34
Hoàng Tuấn 868
H
H
  • Question
Code subtotal và tìm điều kiện
Trả lời
9
Đọc
109
Hoàng Tuấn 868
H
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom