Nhờ anh chị tìm sản phẩm được khách hàng mua thường xuyên cùng nhau

Chia sẻ bởi:hands

★★★★★

‹ Xin hỏi code xóa nhiều vùng trong... Đánh số thứ tự tự động bằng... ›

Quảng cáo

Chào các anh chị!
Em có một câu hỏi nhờ anh chị giúp đỡ:
Em có dữ liệu khách hàng mua hàng các sản phẩm khác nhau, em muốn tìm ra sản phẩm được khách hàng thường xuyên mua, dữ liệu và câu hỏi như sau:
3889
Cảm ơn các anh chị nhiều!

Dựa theo kết quả #9
Power Query

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    tbl0 = Table.Group(Source, {"Khách hàng"}, {{"Count", each List.Count(List.Distinct([Ngày]))}}),
    tbl1 = Table.Group(Source, {"Khách hàng", "Sản Phẩm"}, {{"OderSP", each Table.RowCount(_), Int64.Type}}),
    tbl2 = Table.NestedJoin(tbl1, {"Khách hàng"}, tbl0, {"Khách hàng"}, "tbl1", JoinKind.LeftOuter),
    tbl3 = Table.ExpandTableColumn(tbl2, "tbl1", {"Count"}, {"TotalOder"}),
    tbl4 = Table.AddColumn(tbl3, "DK", each [OderSP]/[TotalOder]),
    tbl5 = Table.SelectRows(tbl4, each [DK] > 0.5),
    KQ = Table.RemoveColumns(tbl5,{"DK"})
in
    KQ

Công thức E365

=LET(so,A2:A4386,sp,B2:B4386,sl,C2:C4386,d,D2:D4386,_ab,so&"|"&sp,uso,UNIQUE(so),od_1,MAP(uso,LAMBDA(x,ROWS(UNIQUE(FILTER(d,so=x))))),uss,UNIQUE(_ab),od_2,MAP(uss,LAMBDA(y,ROWS(FILTER(sp,_ab=y)))),kh,TEXTBEFORE(uss,"|"),_sp,TEXTAFTER(uss,"|"),od_3,XLOOKUP(kh,uso,od_1),FILTER(HSTACK(kh,od_3,_sp,od_2),od_2/od_3>0.5))

www.giaiphapexcel.com/diendan/threads/nh%E1%BB%9D-anh-ch%E1%BB%8B-t%C3%ACm-s%E1%BA%A3n-ph%E1%BA%A9m-%C4%91%C6%B0%E1%BB%A3c-kh%C3%A1ch-h%C3%A0ng-mua-th%C6%B0%E1%BB%9Dng-xuy%C3%AAn-c%C3%B9ng-nhau.164096/#post-1095622

Khóa học SprinGO phù hợp

Xây dựng Lương 3P, KPI cho Doanh nghiệp

Làm thế nào để trả lương cho nhân viên chính xác nhất? Đây là một trong những câu hỏi khó trong quản trị nhân...

Xem khóa học

★★★★★ 5 ★ 1 👤 6 ▥ 0

‹ Xin hỏi code xóa nhiều vùng trong bảng... Đánh số thứ tự tự động bằng VBA ›

Quảng cáo

Bạn nên đọc

Tìm ngày giờ kết thúc dự kiến

Tổng hợp file Excel tính giá thành sản phẩm cho doanh nghiệp sản xuất, gia công, xây lắp

Hướng dẫn xử lý file Excel chậm

Công thức quy đổi lương NET sang GROSS

Tính thưởng lũy tiến

Cách tách chuỗi trong dấu ngoặc Excel bằng công thức và Flash Fill

6 Responses

hands says:

25/02/2023 at 2:40 pm

Bài toán tương đối phức tạp nên mình sẽ làm qua các bước sau:
1- Tạo sheet "Tonghop"
Mỗi đơn hàng là 1 dòng
Mỗi sản phẩm là 1 cột
Nộii dung trong bảng là đếm số lần xuất hiện của mỗi sản phẩm
2- Tạo sheet "Thongke"
Mỗi khách hàng là 1 dòng, và có thống kên số đơn hàng của khách hàng đó
Mỗi sản phẩm là 1 cột. Cho mỗi sản phẩm, thống kê % xuất hiện của sản phẩm đó cho mỗi khách hàng. Chỉ liệt kê số liệu >50%, nếu dưới thì tự động loại bỏ ra.
3- Về yêu cầu trích ra "các SP cùng nhau xuất hiện >75%", mình vẫn chưa hiểu yêu cầu này.
Nếu được thì căn cứ vào các bảng kết quả nói trên, bạn làm tay một vài trường hợp ra xem sao.

Option Explicit
Sub test()
Dim lr&, i&, j&, k&, s, rng, arr(), id As String, cell As Range
Dim dicKH As Object, dicSP As Object
Set dicKH = CreateObject("Scripting.Dictionary")
Set dicSP = CreateObject("Scripting.Dictionary")
With Sheets("data")
lr = .Cells(Rows.Count, "A").End(xlUp).Row
rng = .Range("A2:D" & lr).Value
ReDim arr(1 To 100000, 1 To 2)
For i = 1 To UBound(rng)
id = rng(i, 1) & "|" & rng(i, 4)
If Not dicKH.exists(id) Then
dicKH.Add id, rng(i, 2)
k = k + 1: arr(k, 1) = rng(i, 1): arr(k, 2) = rng(i, 4)
Else
dicKH(id) = dicKH(id) & "|" & rng(i, 3)
End If
If Not dicSP.exists(rng(i, 2)) Then dicSP.Add rng(i, 2), ""
Next
End With
With Sheets("Tonghop")
.Cells.ClearContents
.Range("B1").Value = Sheets("Data").Range("A1").Value: .Range("C1").Value = Sheets("Data").Range("D1").Value
.Range("B2").Resize(k, 2).Value = arr
.Range("D1").Resize(1, dicSP.Count).Value = dicSP.keys
.Range("D2").Resize(dicKH.Count, dicSP.Count).Formula = "=COUNTIFS(data!$A$2:$A$4387,$B2,data!$D$2:$D$4387,$C2,data!$B$2:$B$4387,D$1)"
rng = .Range("B2").Resize(dicKH.Count, 1).Value
End With
dicKH.RemoveAll
With Sheets("Thongke")
.Cells.ClearContents
.Range("B1").Value = Sheets("Tonghop").Range("B1").Value: .Range("C1").Value = "So don hang"
For i = 1 To UBound(rng)
If Not dicKH.exists(rng(i, 1)) Then
dicKH.Add rng(i, 1), 1
Else
dicKH(rng(i, 1)) = dicKH(rng(i, 1)) + 1
End If
Next
.Range("B2").Resize(dicKH.Count, 1).Value = WorksheetFunction.Transpose(dicKH.keys)
.Range("C2").Resize(dicKH.Count, 1).Value = WorksheetFunction.Transpose(dicKH.items)
.Range("D1").Resize(1, dicSP.Count).Value = dicSP.keys
With .Range("D2").Resize(dicKH.Count, dicSP.Count)
.Formula = "=IF(SUMIF(Tonghop!$B$2:$B$10000,$B2,Tonghop!D$2:D$10000)/$C2>0.5,SUMIF(Tonghop!$B$2:$B$10000,$B2,Tonghop!D$2:D$10000)/$C2,"""")"
.NumberFormat = "0%"
End With
For Each cell In .Range("D1").Resize(1, dicSP.Count)
If WorksheetFunction.Sum(cell.Resize(dicKH.Count, 1)) = 0 Then cell.ClearContents
Next
.Range("D1").Resize(1, dicSP.Count).SpecialCells(xlBlanks).EntireColumn.Delete
End With
End Sub

Reply

hands says:

25/02/2023 at 2:40 pm

Sản phẩm B mua cùng sản phẩm A, ngược lại chưa chắc Sản phẩm A mua cùng sản phẩm B
Kiểm tra lại

Option Explicit
Sub XYZ()
  Dim arr(), a, SP(), res(), res2(), dh$, dhSP$, dic As Object, dicDH As Object
  Dim sRow&, sR$, i&, j&, r&, id&, jd&, sSP&, k&, k2&, sDon#, iSP#

Set dic = CreateObject("scripting.dictionary")
  Set dicDH = CreateObject("scripting.dictionary")
  arr = Range("A2", Range("D" & Rows.Count).End(xlUp)).Value
  sRow = UBound(arr)
  ReDim res(1 To sRow, 1 To 2)

For i = 1 To sRow
    If arr(i, 3) > 0 Then
      If dic.exists(arr(i, 2)) = False Then
        sSP = sSP + 1 'So San Pham
        res(sSP, 2) = arr(i, 2)
        dic.Add arr(i, 2), sSP
      End If
      dh = arr(i, 1) & "|" & arr(i, 4)
      dhSP = dh & "|" & arr(i, 2)
      If dic.exists(dhSP) = False Then
        dic.Add dhSP, ""
        If dicDH.exists(dh) = False Then
          sDon = sDon + 1 'So Don hang
          dicDH.Add dh, Array(arr(i, 2))
        Else
          a = dicDH(dh) 'San Pham cua Don hang
          ReDim Preserve a(0 To UBound(a) + 1)
          a(UBound(a)) = arr(i, 2)
          dicDH(dh) = a
        End If
      End If
    End If
  Next i
  ReDim SP(1 To sSP, 0 To sSP)
  ReDim res2(1 To sSP, 1 To sSP)

For Each a In dicDH.items
    sRow = UBound(a)
    For i = 0 To sRow
      id = dic(a(i))
      SP(id, 0) = SP(id, 0) + 1
      For j = 0 To sRow
        jd = dic(a(j))
        If id <> jd Then
          SP(id, jd) = SP(id, jd) + 1
        End If
      Next j
    Next i
  Next a

sDon = sDon * 0.5  '50% So Don hang
  For i = 1 To sSP
    If SP(i, 0) > sDon Then
      k = k + 1
      res(k, 1) = res(i, 2)
    End If
    iSP = SP(i, 0) * 0.75  '75% So San Pham
    jd = 1
    For j = 1 To sSP
      If SP(i, j) > iSP Then
        If jd = 1 Then
          k2 = k2 + 1
          res2(k2, 1) = res(i, 2)
        End If
        jd = jd + 1
        res2(k2, jd) = res(j, 2)
      End If
    Next j
  Next i
  Range("F6").Resize(k) = res 'SP mua thuong xuyên
  Range("H6").Resize(k2, sSP) = res2 'Sp mua cung nhau
End Sub

hands says:

04/03/2023 at 9:02 pm

Dùng cách vét cạn và tìm cách tăng tốc xử lý nên code khá phức tạp, kết quả liệt kê tất cả các trường hợp mua chung
Kiểm tra lại kết quả

Option Explicit
Sub XYZ()
  Dim dic As Object, dic2 As Object, dKH As Object, dDH As Object, dSP As Object
  Dim aTH$(), sTH&, sCol&, iMin&
  Dim arr(), res(), aDH, aSP, a, b()
  Dim dh$, sp$, kh, tmp$
  Dim sRow&, sDH&, sDon#, k&, N&, i&, j&, r&, c&, id&, jd&

iMin = -1 'Dieu kien xet cot So luong: So luong >= 0 (iMin = -1), So luong >0 (iMin = 0)
  sCol = 10 'Thong thuong: 10 < sCol < 20
  Call Creat_TH(aTH, sTH, sCol)
  Set dic = CreateObject("scripting.dictionary")
  Set dic2 = CreateObject("scripting.dictionary")
  Set dKH = CreateObject("scripting.dictionary")
  Set dDH = CreateObject("scripting.dictionary")
  Set dSP = CreateObject("scripting.dictionary")
  arr = Range("A2", Range("D" & Rows.Count).End(xlUp)).Value
  sRow = UBound(arr)
  ReDim res(1 To sRow, 1 To 5)

For i = 1 To sRow
    If arr(i, 3) > iMin Then
      kh = arr(i, 1)
      dh = kh & "|" & arr(i, 4)
      sp = dh & "|" & arr(i, 2)
      If dSP.exists(sp) = False Then
        dSP.Add sp, ""
        If dDH.exists(dh) = False Then
          dDH.Add dh, Array(arr(i, 2))
          If dKH.exists(kh) = False Then
            dKH(kh) = Array(dh)
          Else
            a = dKH(kh) 'Gan DH moi vao Khach hang
            ReDim Preserve a(0 To UBound(a) + 1)
            a(UBound(a)) = dh
            dKH(kh) = a
          End If
        Else
          a = dDH(dh) 'gán San Pham vào Don hang
          ReDim Preserve a(0 To UBound(a) + 1)
          a(UBound(a)) = arr(i, 2)
          dDH(dh) = a
        End If
      End If
    End If
  Next i

For Each kh In dKH.keys
    aDH = dKH(kh)
    sDH = UBound(aDH)  'So Don Hang
    sDon = (sDH + 1) * 0.75 '75% So Don hang
    dic.RemoveAll:    dic2.RemoveAll
    k = 0
    For i = 0 To sDH
      aSP = dDH(aDH(i))
      For j = 0 To UBound(aSP)
        sp = aSP(j)
        N = dic(sp) + 1
        dic(sp) = N
        If N > sDon Then
          If dic2.exists(sp) = False Then
            k = k + 1
            dic2.Add sp, k
            ReDim Preserve a(1 To k)
            a(k) = sp
            For c = 0 To sDH
              If dSP.exists(aDH(c) & "|" & sp) Then dic2(c & "|" & sp) = ""
            Next c
          End If
        End If
      Next j
    Next i

If k > 1 Then
      If k > sCol Then sCol = k: Call Creat_TH(aTH, sTH, sCol) 'Tao lai TH Lon hon
      For i = 1 To sTH
        N = aTH(i, 2):        If N > k Then Exit For
        tmp = aTH(i, 1)
        jd = 0: id = 0
        For j = 1 To N
          If Mid(tmp, j, 1) = "1" Then
            jd = jd + 1
            ReDim Preserve b(1 To jd)
            b(jd) = a(j)
          End If
        Next j

For c = 0 To sDH
          For j = 1 To jd
            If dic2.exists(c & "|" & b(j)) = False Then Exit For
          Next j
          If j = jd + 1 Then id = id + 1 'Dem so don hang cua San pham
        Next c
        If id > sDon Then
          r = r + 1
          res(r, 1) = kh
          res(r, 2) = sDH + 1
          res(r, 3) = sDon
          res(r, 4) = id
          res(r, 5) = Join(b, ", ")
        End If
      Next i
    End If
  Next kh
  If Range("H6").Value <> Empty Then Range("H6").CurrentRegion.ClearContents
  If r Then Range("H6").Resize(r, 5) = res 'Sp mua cung nhau
End Sub

Sub Creat_TH(aTH, sTH, sCol)
  Dim N&, i&, j&, S&, r&, tmp$

ReDim bTH(2 To sCol, 1 To 1)
  j = 2
  N = 2 ^ sCol - 1
  ReDim aTH(1 To N - 2, 1 To 2)
  For i = 3 To N
    tmp = D2B(i, sCol)
    If tmp <> Empty Then
      r = r + 1
      aTH(r, 1) = StrReverse(tmp)
      aTH(r, 2) = j
    End If
    If i >= S Then
      j = j + 1
      S = 2 ^ j
    End If
  Next i
  sTH = r
End Sub

Function D2B(num, sCol) As String
  Dim qt&, rd&, tmp$, L&
  qt = num
  Do
    rd = qt Mod 2
    If rd = 1 Then L = L + 1
    qt = Int(qt / 2)
    tmp = rd & tmp
  Loop Until qt = 0
  If L > 1 Then D2B = Format(Val(tmp), String(sCol, "0"))
End Function

Kết quả chưa đúng anh ạ, kết quả trùng lặp nhiều mã, ví dụ kháchS0005423
4072
Thực tế nó chỉ có những sản phẩm này thôi ah:

Khách hàng
Tổng đơn
75% đơn
Số đơn
Sản phẩm mua cùng 75% số Bill

S0005423

26

19.5

20 đơn
Sản phẩm: C-PIE02P,C-PIE06P,C-PIE12P,CSTS02P,CSTS06P,CSTS12P(8),OStarKim Chi – Normal,OStarKim Chi – Small,OStarNatural – Small,OStarPMai-TMuoi – Small,OStarS.W – Normal,OStarS.W – Small,SwingChicken – Small,SwingMAXX – Bo Small,SwingNYSteak – Normal,SwingNYSteak-Small

S0005423

26

19.5

21 đơn
Sản phẩm: C-PIE02P,C-PIE12P,CSTS12P(8),OStarKim Chi – Normal,OStarNatural – Small,OStarS.W – Normal,OStarS.W – Small,SwingNYSteak – Normal,SwingNYSteak-Small

S0005423

26

19.5

22 đơn
Sản phẩm: C-PIE02P,C-PIE12P,CSTS02P,CSTS06P,OStarKim Chi – Small,OStarNatural – Small,OStarPMai-TMuoi – Small,OStarS.W – Normal,SwingChicken – Small

S0005423

26

19.5

23 đơn
Sản phẩm: CSTS02P,CSTS06P,CSTS12P(8),OStarKim Chi – Small,OStarNatural – Small,OStarPMai-TMuoi – Small,OStarS.W – Small,SwingChicken – Small,SwingNYSteak-Small

S0005423

26

19.5

24 đơn
Sản phẩm: C-PIE02P,C-PIE12P,CSTS02P,CSTS06P,CSTS12P(8),OStarKim Chi – Small,OStarNatural – Small,OStarPMai-TMuoi – Small,OStarS.W – Small,SwingChicken – Small,SwingNYSteak-Small

S0005423

26

19.5

25 đơn
Sản phẩm: C-PIE02P,C-PIE12P,CSTS12P(8),OStarS.W – Small,SwingNYSteak-Small

S0005423

26

19.5

26 đơn
Sản phẩm: C-PIE02P,C-PIE12P

Code mình liệt kê tất cả các tổ hợp, nếu có 3 sp mua cùng sẽ liệt kê 4 trường hợp

Em chưa lọc toàn bộ nhưng nếu liệt kê như vậy thì khả năng bỏ trùng tất cả các sku cho tất cả các trường hợp >75% đơn khả năng là sẽ ra tất cả các sku cuối cùng

Mình chưa hiểu ý của bạn "khả năng bỏ trùng tất cả các sku cho tất cả các trường hợp >75% đơn khả năng là sẽ ra tất cả các sku cuối cùng"

hands says:

04/03/2023 at 9:05 pm

Bạn nói không rỏ nên Code mình liệt kê toàn bộ các trường hợp kết quả, để khi cần xử lý tiếp sẽ thuận tiện hơnCụ thể khách hàng S0005360 bạn muốn kết quả là gì?

Theo kết quả bạn ấy đưa thì bài này chỉ xét 2 cặp thôi sau group lại theo số đơn

Theo một cách logic như đã diễn giải thì có thể dùng Power Bi phân tích được, vấn đề phát sinh với dữ liệu lớn và hàng trăm sku, nếu nó chạy tổ hợp như vậy rất là nặng máy, nếu chạy 1,2 cái câu hỏi như vậy thì khả năng dẫn đến ngồi chơi xơi nước. Em vẫn nghĩ R hay Python sẽ mạnh hơn trong cái khoản phân tích này dù sao Power Bi chủ yếu mạnh mẽ ở phần trực quan hóa thôi. Em tìm kiếm giải pháp ngoài Power Bi

Bữa trước thấy bài của bạn rồi tính không giải, mà thấy có vẻ chưa xong nên tham gia chút cho vui. Mà Power BI nó rất mạnh ở xử lý (ETL) và phân tích chứ không riêng gì trực quan hóa, về công nghệ nó ngang với Analysis services mạnh hơn mấy thằng Relational database, nên dữ liệu vài chục trệu dòng Power BI mà chậm thì dùng Python SQL cũng chẳng khá hơn đâu
Bài này tôi làm trên group Power BI cũng khá lâu rồi y chang bài bạn hỏi, như cái report bạn đưa thì dùng thằng nào làm cũng được kể cả excel (excel thì khá nặng), và Power BI nhanh nhất so với SQL, Python (Python sài thư viện dành cho machine learning sẽ nhanh hơn với dữ liệu lớn), Power BI tôi viết lại 3 cách 2 table và 1 measure, Python tôi viết 2 cách, cách 1 theo kết quả report của bạn , cách 2 dùng thư viện mlxtend trả vét cạn giống kêt của bạn HieuCD muốn ra kết quả của bạn thêm vài step (dùng max_len) nữa là được, Excel thì dùng công thức 365 nhưng nó rất nặng mặc dù đã tách ra rồi nên chỉ tham khảo thôi vì giờ excel nó có đầy đủ vòng lặp , đệ quy nên làm mấy bài này là được, cùng 1 thuật toán power BI mất 0.05s, Python 0.2s, Excel> 1 phút
407540744073

Cảm ơn anh nhiều nhé! Công nhận đoạn code Dax của anh chạy nhanh thật, em viết cũng ra nhưng chạy máy bàn 64gb ram mà vẫn mất 20s, chạy lapop ram thấp là quay quay mãi mới ra được. Do em chỉ biết chút Dax nên vẫn nghĩ Python sẽ nhanh hơn.
Một lần nữa cảm ơn anh!

Reply
hands says:

11/03/2023 at 3:33 pm

Thuật toán vét cạn là thế nào bạn nhỉ? Có thể nói cho tôi biết sơ lược cách làm được không?

Vét cạn có điều kiện thì tôi dùng thư viện Python, chứ dữ liệu nhiều vét cạn dùng vòng lặp thì không khả thi, ví dụ hình dưới tính tổ hợp 40 sản phẩm đã thỏa điều kiện thì lượng vòng lặp đã trên 1000 tỷ rồi, tôi dùng fpgrowth sử dụng thuật thuật toán FP-Tree4249

Xin anh tham khảo all code Python để mọi người ham khảo với ạ !

Reply

hands says:

16/03/2023 at 2:18 pm

Bạn có thể tham khảo code R:

install.packages("writexl")
install.packages("openxlsx")
library(readxl)
data <- read_excel("C:/Users/Admin/Desktop/data.xlsx")
[I]#View(data)[/I]
library(arules)
library(Matrix)
library(writexl)
[I]# Tạo danh sách sản phẩm cho từng khách hàng[/I]
transactions <- split(data$"Sản Phẩm", data$"Khách hàng")
[I]# Chuyển đổi danh sách sản phẩm thành dạng ma trận[/I]
trans_matrix <- as(transactions, "transactions")
[I]# Phân tích bán chéo sản phẩm sử dụng thuật toán Apriori[/I]
rules <- apriori(trans_matrix, parameter = list(supp = 0.75, conf = 1))
df <- data.frame(lhs = labels(lhs(rules)),
                 rhs = labels(rhs(rules)),
                 support = quality(rules)$support,
                 confidence = quality(rules)$confidence)
write_xlsx(df, "C:/Users/Admin/Desktop/rules.xlsx")

Tôi chưa thành thao R lắm nhưng chạy tạm, sử dụng thuật toán Apriori