HỎI - Đếm số lần KH order (2 người xem)

iamcuong · 9/2/19

Thân gửi các chú, các anh em trên GPE!
Đầu xuân em có vấn đề sau, mong anh em hỗ trợ thêm ạ.
- Mỗi KH là 1 email.
- Mỗi lần order là 1 mã order mới.
- 1 order KH có thể mua nhiều món, mỗi món tính bằng 1 dòng
=> Đếm số lần xuất hiện email của KH, nếu có số order trùng nhau ở các hàng thì chỉ đếm 1 lần

Vậy làm thế nào để ra kết quả như cột G&H ạ?
Cám ơn các chú, các anh em trên GPE Nhiều ạ.
Chúc cả nhà 1 năm thật nhiều sức khỏe và làm việc hiệu quả với Excel ạ.

snow25 · 9/2/19

iamcuong đã viết:
Thân gửi các chú, các anh em trên GPE!
Đầu xuân em có vấn đề sau, mong anh em hỗ trợ thêm ạ.
- Mỗi KH là 1 email.
- Mỗi lần order là 1 mã order mới.
- 1 order KH có thể mua nhiều món, mỗi món tính bằng 1 dòng
=> Đếm số lần xuất hiện email của KH, nếu có số order trùng nhau ở các hàng thì chỉ đếm 1 lần

Vậy làm thế nào để ra kết quả như cột G&H ạ?
Cám ơn các chú, các anh em trên GPE Nhiều ạ.
Chúc cả nhà 1 năm thật nhiều sức khỏe và làm việc hiệu quả với Excel ạ.
View attachment 212018

Vba dùng không bạn.

iamcuong · 9/2/19

snow25 đã viết:
Vba dùng không bạn.

Dạ em đang hướng đến PA nào đơn giản nhất có thể, VBA hoặc hàm ạ.

Phuocam · 9/2/19

iamcuong đã viết:
- Mỗi KH là 1 email.

Cột G yêu cầu cao, vừa sắp xếp tử a - z vừa loại trùng.

snow25 · 9/2/19

iamcuong đã viết:
Dạ em đang hướng đến PA nào đơn giản nhất có thể, VBA hoặc hàm ạ.

Đây là mình viết hàm tự tạo nhé.

Mã:

Function timgiatri(ByVal mang As Range, ByVal dk As String) As Integer
        Dim arr, i As Long, dem As Integer, a As Integer
        arr = mang.Value
        For i = 1 To UBound(arr, 1)
            If UCase(dk) = UCase(arr(i, 2)) Then
               If InStr(s, "#" & arr(i, 1) & "#") = 0 Then
                  dem = dem + 1
                  If s = Empty Then s = "#" & arr(i, 1) & "#" Else s = s & arr(i, 1) & "#"
               End If
            End If
        Next i
        timgiatri = dem
End Function

Mã:

=timgiatri($B$2:$C$29,G2)

Phuocam · 9/2/19

Công thức cột H có nhiều trên diễn đàn, như:

=SUMPRODUCT(($C$2:$C$29=G2)/COUNTIFS($C$2:$C$29,$C$2:$C$29,$B$2:$B$29,$B$2:$B$29))

Đang chờ công thức cột G.

HieuCD · 9/2/19

snow25 đã viết:

Đây là mình viết hàm tự tạo nhé.

Mã:

Function timgiatri(ByVal mang As Range, ByVal dk As String) As Integer
        Dim arr, i As Long, dem As Integer, a As Integer
        arr = mang.Value
        For i = 1 To UBound(arr, 1)
            If UCase(dk) = UCase(arr(i, 2)) Then
               If InStr(s, "#" & arr(i, 1) & "#") = 0 Then
                  dem = dem + 1
                  If s = Empty Then s = "#" & arr(i, 1) & "#" Else s = s & arr(i, 1) & "#"
               End If
            End If
        Next i
        timgiatri = dem
End Function

Mã:

=timgiatri($B$2:$C$29,G2)

Thử tìm cách bỏ If:
If s = Empty Then s = "#" & arr(i, 1) & "#" Else s = s & arr(i, 1) & "#"

snow25 · 9/2/19

iamcuong đã viết:
Dạ em đang hướng đến PA nào đơn giản nhất có thể, VBA hoặc hàm ạ.

Còn đây là sub vba.

Mã:

Sub demonhang()
    Dim arr, i As Long, dem As Integer, a As Integer, dic As Object, lr As Long, arr1
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("sheet6")
         lr = .Range("B" & Rows.Count).End(xlUp).Row
         If lr < 2 Then Exit Sub
         arr = .Range("B2:C" & lr).Value
         ReDim arr1(1 To UBound(arr, 1), 1 To 2)
         For i = 1 To UBound(arr, 1)
            If Not dic.exists(arr(i, 2)) Then
              a = a + 1
              arr1(a, 1) = arr(i, 2)
              arr1(a, 2) = 1
              dic.Item(arr(i, 2)) = Array("#" & arr(i, 1) & "#", a)
            Else
              s = dic.Item(arr(i, 2))(0)
              If InStr(s, "#" & arr(i, 1) & "#") = 0 Then
                 s = s & arr(i, 1) & "#"
                 dem = dic.Item(arr(i, 2))(1)
                 arr1(dem, 2) = arr1(dem, 2) + 1
              End If
            End If
       Next i
       lr = .Range("G" & Rows.Count).End(xlUp).Row
       If lr > 1 Then .Range("G2:h" & lr).ClearContents
       If a Then .Range("G2").Resize(a, 2).Value = arr1
  End With
 Set dic = Nothing
End Sub

dazkangel · 9/2/19

Thử làm 1 cách bằng hàm:

iamcuong · 9/2/19

snow25 đã viết:
Đây là mình viết hàm tự tạo nhé.

Dạ dùng hàm của anh ra chuẩn kết quả luôn ạ.
File này em lại phải gửi cho KH, sợ họ không biết dùng.
Có phương án nào dùng pivottable kết hợp vs 1 số hàm không ạ?

HieuCD · 9/2/19

snow25 đã viết:

Còn đây là sub vba.

Mã:

Sub demonhang()
    Dim arr, i As Long, dem As Integer, a As Integer, dic As Object, lr As Long, arr1
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("sheet6")
         lr = .Range("B" & Rows.Count).End(xlUp).Row
         If lr < 2 Then Exit Sub
         arr = .Range("B2:C" & lr).Value
         ReDim arr1(1 To UBound(arr, 1), 1 To 2)
         For i = 1 To UBound(arr, 1)
            If Not dic.exists(arr(i, 2)) Then
              a = a + 1
              arr1(a, 1) = arr(i, 2)
              arr1(a, 2) = 1
              dic.Item(arr(i, 2)) = Array("#" & arr(i, 1) & "#", a)
            Else
              s = dic.Item(arr(i, 2))(0)
              If InStr(s, "#" & arr(i, 1) & "#") = 0 Then
                 s = s & arr(i, 1) & "#"
                 dem = dic.Item(arr(i, 2))(1)
                 arr1(dem, 2) = arr1(dem, 2) + 1
              End If
            End If
       Next i
       lr = .Range("G" & Rows.Count).End(xlUp).Row
       If lr > 1 Then .Range("G2:h" & lr).ClearContents
       If a Then .Range("G2").Resize(a, 2).Value = arr1
  End With
Set dic = Nothing
End Sub

Lệnh: s = s & arr(i, 1) & "#"
Không có tác dụng vì sau đó S không dùng làm gì

Bài nầy không nên dùng vừa Dic vừa Instr, chỉ chọn 1 trong 2

snow25 · 9/2/19

HieuCD đã viết:
Lệnh: s = s & arr(i, 1) & "#"
Không có tác dụng vì sau đó S không dùng làm gì
Bài nầy không nên dùng vừa Dic vừa Instr, chỉ chọn 1 trong 2

Vâng cảm ơn anh.Chắc bánh trưng đi hết kiến thức rồi anh ạ.Để hôm khác em viết lại.Hi giờ nghỉ tết đã.

snow25 · 10/2/19

HieuCD đã viết:
Lệnh: s = s & arr(i, 1) & "#"
Không có tác dụng vì sau đó S không dùng làm gì
Bài nầy không nên dùng vừa Dic vừa Instr, chỉ chọn 1 trong 2

Anh xem đúng không nhé.

Mã:

Sub demonhang()
    Dim arr, i As Long, dem As Integer, a As Integer, dic As Object, lr As Long, arr1
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("sheet6")
         lr = .Range("B" & Rows.Count).End(xlUp).Row
         If lr < 2 Then Exit Sub
         arr = .Range("B2:C" & lr).Value
         ReDim arr1(1 To UBound(arr, 1), 1 To 2)
         For i = 1 To UBound(arr, 1)
            If Not dic.exists(arr(i, 2)) Then
              a = a + 1
              arr1(a, 1) = arr(i, 2)
              arr1(a, 2) = 1
              dic.Item(arr(i, 2)) = Array("#" & arr(i, 1) & "#", a)
            Else
              s = dic.Item(arr(i, 2))(0)
              If InStr(s, "#" & arr(i, 1) & "#") = 0 Then
                 s = s & arr(i, 1) & "#"
                 dem = dic.Item(arr(i, 2))(1)
                 arr1(dem, 2) = arr1(dem, 2) + 1
                 dic.Item(arr(i, 2)) = Array(s, dem)
              End If
            End If
       Next i
       lr = .Range("G" & Rows.Count).End(xlUp).Row
       If lr > 1 Then .Range("G2:h" & lr).ClearContents
       If a Then .Range("G2").Resize(a, 2).Value = arr1
  End With
 Set dic = Nothing
End Sub

Cái này dùng Dic không à.Em vẫn không nghĩ ra dùng Instr à.

Mã:

Sub demdonhang()
    Dim arr, i As Long, dem As Integer, a As Integer, dic As Object, lr As Long, arr1, dk As String
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("sheet6")
         lr = .Range("B" & Rows.Count).End(xlUp).Row
         If lr < 2 Then Exit Sub
         arr = .Range("B2:C" & lr).Value
         ReDim arr1(1 To UBound(arr, 1), 1 To 2)
         For i = 1 To UBound(arr, 1)
             dk = arr(i, 1) & "#" & arr(i, 2)
            If Not dic.exists(arr(i, 2)) Then
              a = a + 1
              arr1(a, 1) = arr(i, 2)
              arr1(a, 2) = 1
              dic.Add dk, ""
              dic.Item(arr(i, 2)) = Array(a)
            Else
              If Not dic.exists(dk) Then
                 dic.Add dk, ""
                 dem = dic.Item(arr(i, 2))(0)
                 arr1(dem, 2) = arr1(dem, 2) + 1
              End If
            End If
       Next i
       lr = .Range("G" & Rows.Count).End(xlUp).Row
       If lr > 1 Then .Range("G2:h" & lr).ClearContents
       If a Then .Range("G2").Resize(a, 2).Value = arr1
  End With
 Set dic = Nothing
End Sub

HieuCD · 10/2/19

snow25 đã viết:

Anh xem đúng không nhé.

Mã:

Sub demonhang()
    Dim arr, i As Long, dem As Integer, a As Integer, dic As Object, lr As Long, arr1
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("sheet6")
         lr = .Range("B" & Rows.Count).End(xlUp).Row
         If lr < 2 Then Exit Sub
         arr = .Range("B2:C" & lr).Value
         ReDim arr1(1 To UBound(arr, 1), 1 To 2)
         For i = 1 To UBound(arr, 1)
            If Not dic.exists(arr(i, 2)) Then
              a = a + 1
              arr1(a, 1) = arr(i, 2)
              arr1(a, 2) = 1
              dic.Item(arr(i, 2)) = Array("#" & arr(i, 1) & "#", a)
            Else
              s = dic.Item(arr(i, 2))(0)
              If InStr(s, "#" & arr(i, 1) & "#") = 0 Then
                 s = s & arr(i, 1) & "#"
                 dem = dic.Item(arr(i, 2))(1)
                 arr1(dem, 2) = arr1(dem, 2) + 1
                 dic.Item(arr(i, 2)) = Array(s, dem)
              End If
            End If
       Next i
       lr = .Range("G" & Rows.Count).End(xlUp).Row
       If lr > 1 Then .Range("G2:h" & lr).ClearContents
       If a Then .Range("G2").Resize(a, 2).Value = arr1
  End With
Set dic = Nothing
End Sub

Cái này dùng Dic không à.Em vẫn không nghĩ ra dùng Instr à.

Mã:

Sub demdonhang()
    Dim arr, i As Long, dem As Integer, a As Integer, dic As Object, lr As Long, arr1, dk As String
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("sheet6")
         lr = .Range("B" & Rows.Count).End(xlUp).Row
         If lr < 2 Then Exit Sub
         arr = .Range("B2:C" & lr).Value
         ReDim arr1(1 To UBound(arr, 1), 1 To 2)
         For i = 1 To UBound(arr, 1)
             dk = arr(i, 1) & "#" & arr(i, 2)
            If Not dic.exists(arr(i, 2)) Then
              a = a + 1
              arr1(a, 1) = arr(i, 2)
              arr1(a, 2) = 1
              dic.Add dk, ""
              dic.Item(arr(i, 2)) = Array(a)
            Else
              If Not dic.exists(dk) Then
                 dic.Add dk, ""
                 dem = dic.Item(arr(i, 2))(0)
                 arr1(dem, 2) = arr1(dem, 2) + 1
              End If
            End If
       Next i
       lr = .Range("G" & Rows.Count).End(xlUp).Row
       If lr > 1 Then .Range("G2:h" & lr).ClearContents
       If a Then .Range("G2").Resize(a, 2).Value = arr1
  End With
Set dic = Nothing
End Sub

Bài nầy dùng Dic thích hợp hơn Instr, dùng instr phải chuyển mail về cùng số ký tự để tính thứ tự dòng
Cách dùng Dic của mình

Mã:

Sub demdonhang2()
    Dim sArr(), Res(), i As Long, k As Long, ik As Long, lr As Long
    Dim Dic As Object, iKey As String, iKey2 As String
    Set Dic = CreateObject("scripting.dictionary")
    With Sheets("sheet6")
        lr = .Range("B" & Rows.Count).End(xlUp).Row
        If lr < 2 Then Exit Sub
        sArr = .Range("B2:C" & lr).Value
        ReDim Res(1 To UBound(sArr, 1), 1 To 2)
        For i = 1 To UBound(sArr, 1)
            iKey = sArr(i, 2)
            If Not Dic.exists(iKey) Then
                k = k + 1
                Dic.Add iKey, k
                Res(k, 1) = sArr(i, 2)
            End If
            iKey2 = iKey & "#" & sArr(i, 1)
            If Not Dic.exists(iKey2) Then
                Dic.Add iKey2, ""
                ik = Dic.Item(iKey)
                Res(ik, 2) = Res(ik, 2) + 1
            End If
       Next i
       lr = .Range("G" & Rows.Count).End(xlUp).Row
       If lr > 1 Then .Range("G2:H" & lr).ClearContents
       If k Then .Range("G2").Resize(k, 2).Value = Res
    End With
    Set Dic = Nothing
End Sub

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

HieuCD đã viết:

Bài nầy dùng Dic thích hợp hơn Instr, dùng instr phải chuyển mail về cùng số ký tự để tính thứ tự dòng
Cách dùng Dic của mình

Mã:

Sub demdonhang2()
    Dim sArr(), Res(), i As Long, k As Long, ik As Long, lr As Long
    Dim Dic As Object, iKey As String, iKey2 As String
    Set Dic = CreateObject("scripting.dictionary")
    With Sheets("sheet6")
        lr = .Range("B" & Rows.Count).End(xlUp).Row
        If lr < 2 Then Exit Sub
        sArr = .Range("B2:C" & lr).Value
        ReDim Res(1 To UBound(sArr, 1), 1 To 2)
        For i = 1 To UBound(sArr, 1)
            iKey = sArr(i, 2)
            If Not Dic.exists(iKey) Then
                k = k + 1
                Dic.Add iKey, k
                Res(k, 1) = sArr(i, 2)
            End If
            iKey2 = iKey & "#" & sArr(i, 1)
            If Not Dic.exists(iKey2) Then
                Dic.Add iKey2, ""
                ik = Dic.Item(iKey)
                Res(ik, 2) = Res(ik, 2) + 1
            End If
       Next i
       lr = .Range("G" & Rows.Count).End(xlUp).Row
       If lr > 1 Then .Range("G2:H" & lr).ClearContents
       If k Then .Range("G2").Resize(k, 2).Value = Res
    End With
    Set Dic = Nothing
End Sub

Phân tích quan hệ đơn hàng và khách hàng
iKey2 = iKey & "#" & sArr(i, 1) dư iKey
1 đơn hàng của 1 khách hàng, 1 khách hàng có thể đặt nhiều đơn hàng
Quan hệ khách hàng và đơn hàng là: 1 - nhiều
Biết đơn hàng sẽ xác định được 1 khách hàng, nên chỉ cần
iKey2 = sArr(i, 1)

Mã:

Sub demdonhang3()
    Dim sArr(), Res(), i As Long, k As Long, ik As Long, lr As Long
    Dim Dic As Object, iKey As String, iKey2 As String
    Set Dic = CreateObject("scripting.dictionary")
    With Sheets("sheet6")
        lr = .Range("B" & Rows.Count).End(xlUp).Row
        If lr < 2 Then Exit Sub
        sArr = .Range("B2:C" & lr).Value
        ReDim Res(1 To UBound(sArr, 1), 1 To 2)
        For i = 1 To UBound(sArr, 1)
            iKey = sArr(i, 2)
            If Not Dic.exists(iKey) Then
                k = k + 1
                Dic.Add iKey, k
                Res(k, 1) = sArr(i, 2)
            End If
            iKey2 = sArr(i, 1)
            If Not Dic.exists(iKey2) Then
                Dic.Add iKey2, ""
                ik = Dic.Item(iKey)
                Res(ik, 2) = Res(ik, 2) + 1
            End If
       Next i
       lr = .Range("G" & Rows.Count).End(xlUp).Row
       If lr > 1 Then .Range("G2:H" & lr).ClearContents
       If k Then .Range("G2").Resize(k, 2).Value = Res
    End With
    Set Dic = Nothing
End Sub

Ba Tê · 10/2/19

iamcuong đã viết:
- Mỗi KH là 1 email.
- Mỗi lần order là 1 mã order mới.
- 1 order KH có thể mua nhiều món, mỗi món tính bằng 1 dòng
=> Đếm số lần xuất hiện email của KH, nếu có số order trùng nhau ở các hàng thì chỉ đếm 1 lần

Gặp đơn hàng mới, mới xét xem của ai. Đơn hàng cũ (đã có) thì bỏ qua.
Sort luôn cho bạn:

PHP:

Public Sub sGpe()
Dim sArr(), dArr(), I As Long, K As Long, R As Long, Rws As Long, Txt As String, Tmp As String
sArr = Range("B2", Range("C2").End(xlDown)).Value
R = UBound(sArr)
ReDim dArr(1 To R, 1 To 2)
With CreateObject("Scripting.Dictionary")
    For I = 1 To R
        Tmp = sArr(I, 1)
        Txt = sArr(I, 2)
        If Not .Exists(Tmp) Then
            .Item(Tmp) = ""
            If Not .Exists(Txt) Then
                K = K + 1
                .Item(Txt) = K
                dArr(K, 1) = Txt
                dArr(K, 2) = 1
            Else
                Rws = .Item(Txt)
                dArr(Rws, 2) = dArr(Rws, 2) + 1
            End If
        End If
    Next I
End With
Range("G2").Resize(10000, 2).ClearContents
Range("G2").Resize(K, 2) = dArr
Range("G2").Resize(K, 2).Sort Key1:=Range("G2"), Order1:=xlAscending
End Sub

VetMini · 11/2/19

iamcuong đã viết:
Dạ em đang hướng đến PA nào đơn giản nhất có thể, VBA hoặc hàm ạ.

iamcuong đã viết:
Dạ dùng hàm của anh ra chuẩn kết quả luôn ạ.
File này em lại phải gửi cho KH, sợ họ không biết dùng.
Có phương án nào dùng pivottable kết hợp vs 1 số hàm không ạ?

Tôi tránh làm việc với (1) sự tiền hậu bất nhất, và (2) viết tắt cho nên tôi chỉ mách cho phuonwg pháp chứ khong đi sâu thêm chi tiết.
Có 3 cách làm Pivot Table, tuỳ theo công cụ có sẵn:
1. Excel 2013 trở lên: dùng Data Model, lúc ấy sẽ liệt kê được theo Count Distinct
2. Excel 2010: dùng Pivot Report, và Pivot lần nữa trên cái Pivot Report này. Cách này hơi rắc rối, đòi hỏi kỹ thuật lập name động để bao cái Pivot table thứ nhất.
3. Excel 2007 trở xuống: lập cột phụ (thường thì dùng CountIF)

Thai Huyen · 11/2/19

Bạn có thể dùng Power Pivot: đẩy dữ liệu gốc vào Power Pivot rồi sử dụng hàm DISTINCTCOUNT như hình
Lúc này công thức sẽ được upate vào Fields List
Rồi kéo trường Email với công thức đã tạo (tương tự như trong Pivot Table) sẽ ra kết quả như mong muốn
Mỗi lần udpate dữ liệu mới vào bảng data gốc xong chỉ cần qua bảng kết quả refresh là sẽ update dữ liệu mới

hocexcel_1991 · 11/2/19

VetMini đã viết:
Tôi tránh làm việc với (1) sự tiền hậu bất nhất, và (2) viết tắt cho nên tôi chỉ mách cho phuonwg pháp chứ khong đi sâu thêm chi tiết.
Có 3 cách làm Pivot Table, tuỳ theo công cụ có sẵn:
1. Excel 2013 trở lên: dùng Data Model, lúc ấy sẽ liệt kê được theo Count Distinct
2. Excel 2010: dùng Pivot Report, và Pivot lần nữa trên cái Pivot Report này. Cách này hơi rắc rối, đòi hỏi kỹ thuật lập name động để bao cái Pivot table thứ nhất.
3. Excel 2007 trở xuống: lập cột phụ (thường thì dùng CountIF)

Theo chỉ dẫn của Bác, đang dùng Excel 2010.

be_09 · 11/2/19

iamcuong đã viết:
Thân gửi các chú, các anh em trên GPE!
Đầu xuân em có vấn đề sau, mong anh em hỗ trợ thêm ạ.
................................................
Chúc cả nhà 1 năm thật nhiều sức khỏe và làm việc hiệu quả với Excel ạ.

1/ Với File bài 1 thì dùng PivotTable là đơn giản nhất.
2/ Hoặc Copy cột C qua cột G rồi Remove Duplicates, sau đó dùng COUNTIF (tốn công hơn).
3/ Dùng VBA tạo PivotTable lấy dữ liệu động, khi thêm dữ liệu chỉ việc nhấn nút là xong.

VetMini · 11/2/19

Viviankat đã viết:
Bạn có thể dùng Power Pivot: đẩy dữ liệu gốc vào Power Pivot rồi sử dụng hàm DISTINCTCOUNT như hình
...

Power Pivot chỉ có từ 2013 trở lên.
2010 muốn sử dụng nó thì phải download cái package.

HỎI - Đếm số lần KH order (2 người xem)

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

Cám ơn GPE

File đính kèm

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

Cám ơn GPE

Thành viên mới

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

File đính kèm

Thành viên mới

Chuyên gia GPE

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

File đính kèm

<New Horizons>

File đính kèm

Cám ơn GPE

Chuyên gia GPE

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

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

Chuyên gia GPE

Cạo Rồi Khỏi Gội

Ăn cùng góc phố

Thành viên mới

File đính kèm

Bắt đầu học Excel

File đính kèm

Biên Hòa, Đồng Nai

Ăn cùng góc phố

Đếm ngược thời gian