Lọc giá trị duy nhất theo cụm (1 người xem)

hoaiantrinh · Thứ ba lúc 14:58

Nhờ các anh chị hỗ trợ lọc cụm giá trị duy nhất và đếm số lần xuất hiện của cụm đó, em cảm ơn ạ. Có thể viết hàm hoặc code VBA ạ. Em có gửi file đính kèm

HieuCD · Hôm qua, lúc 01:57

hoaiantrinh đã viết:
Nhờ các anh chị hỗ trợ lọc cụm giá trị duy nhất và đếm số lần xuất hiện của cụm đó, em cảm ơn ạ. Có thể viết hàm hoặc code VBA ạ. Em có gửi file đính kèm

Chạy code . . .

Mã:

Sub xyz()
  Dim dic As Object, sh As Worksheet, arr(), res()
  Dim sR&, fR&, i&, k&, ik&
 
  Set dic = CreateObject("scripting.dictionary")
  Set sh = Sheets("Sheet2")
  arr = sh.Range("C3", sh.Range("C" & Rows.Count).End(xlUp)).Value
  sR = UBound(arr)
  ReDim res(1 To sR, 1 To 2)
 
  For i = 1 To sR
    If dic.exists(arr(i, 1)) = False Then
      k = k + 1
      dic.Add arr(i, 1), k
      res(k, 1) = arr(i, 1)
      res(k, 2) = 1
    Else
      ik = dic(arr(i, 1))
      res(ik, 2) = res(ik, 2) + 1
    End If
  Next i
 
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  sR = sh.Range("F" & Rows.Count).End(xlUp).Row
  If sR > 2 Then sh.Range("F3:G" & sR).Clear
  sh.Range("F3").Resize(k, 2) = res
  sh.Range("F3").Resize(k, 2).Sort sh.Range("G3"), 1, sh.Range("F3"), , 1, Header:=xlNo
  For i = 3 To sR
    If sh.Range("G" & i) <> sh.Range("G" & i - 1) Then fR = i
    If sh.Range("G" & i) <> sh.Range("G" & i + 1) Then
      sh.Range("G" & fR, sh.Range("G" & i)).MergeCells = True
    End If
  Next i
  sh.Range("F3").Resize(k, 2).Borders.LineStyle = 1
  sh.Range("G3").Resize(k).HorizontalAlignment = xlCenter
  sh.Range("G3").Resize(k).VerticalAlignment = xlCenter
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
End Sub

LOGANWover · Hôm qua, lúc 08:53

Gửi bạn ý tưởng làm Power query, hy vọng giúp được bạn:

hoaiantrinh · Hôm qua, lúc 10:43

HieuCD đã viết:

Chạy code . . .

Mã:

Sub xyz()
  Dim dic As Object, sh As Worksheet, arr(), res()
  Dim sR&, fR&, i&, k&, ik&
 
  Set dic = CreateObject("scripting.dictionary")
  Set sh = Sheets("Sheet2")
  arr = sh.Range("C3", sh.Range("C" & Rows.Count).End(xlUp)).Value
  sR = UBound(arr)
  ReDim res(1 To sR, 1 To 2)
 
  For i = 1 To sR
    If dic.exists(arr(i, 1)) = False Then
      k = k + 1
      dic.Add arr(i, 1), k
      res(k, 1) = arr(i, 1)
      res(k, 2) = 1
    Else
      ik = dic(arr(i, 1))
      res(ik, 2) = res(ik, 2) + 1
    End If
  Next i
 
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  sR = sh.Range("F" & Rows.Count).End(xlUp).Row
  If sR > 2 Then sh.Range("F3:G" & sR).Clear
  sh.Range("F3").Resize(k, 2) = res
  sh.Range("F3").Resize(k, 2).Sort sh.Range("G3"), 1, sh.Range("F3"), , 1, Header:=xlNo
  For i = 3 To sR
    If sh.Range("G" & i) <> sh.Range("G" & i - 1) Then fR = i
    If sh.Range("G" & i) <> sh.Range("G" & i + 1) Then
      sh.Range("G" & fR, sh.Range("G" & i)).MergeCells = True
    End If
  Next i
  sh.Range("F3").Resize(k, 2).Borders.LineStyle = 1
  sh.Range("G3").Resize(k).HorizontalAlignment = xlCenter
  sh.Range("G3").Resize(k).VerticalAlignment = xlCenter
  Application.DisplayAlerts = True
  Application.ScreenUpdating = Tr
[/QUOTE]

HieuCD đã viết:

Chạy code . . .

Mã:

Sub xyz()
  Dim dic As Object, sh As Worksheet, arr(), res()
  Dim sR&, fR&, i&, k&, ik&
 
  Set dic = CreateObject("scripting.dictionary")
  Set sh = Sheets("Sheet2")
  arr = sh.Range("C3", sh.Range("C" & Rows.Count).End(xlUp)).Value
  sR = UBound(arr)
  ReDim res(1 To sR, 1 To 2)
 
  For i = 1 To sR
    If dic.exists(arr(i, 1)) = False Then
      k = k + 1
      dic.Add arr(i, 1), k
      res(k, 1) = arr(i, 1)
      res(k, 2) = 1
    Else
      ik = dic(arr(i, 1))
      res(ik, 2) = res(ik, 2) + 1
    End If
  Next i
 
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  sR = sh.Range("F" & Rows.Count).End(xlUp).Row
  If sR > 2 Then sh.Range("F3:G" & sR).Clear
  sh.Range("F3").Resize(k, 2) = res
  sh.Range("F3").Resize(k, 2).Sort sh.Range("G3"), 1, sh.Range("F3"), , 1, Header:=xlNo
  For i = 3 To sR
    If sh.Range("G" & i) <> sh.Range("G" & i - 1) Then fR = i
    If sh.Range("G" & i) <> sh.Range("G" & i + 1) Then
      sh.Range("G" & fR, sh.Range("G" & i)).MergeCells = True
    End If
  Next i
  sh.Range("F3").Resize(k, 2).Borders.LineStyle = 1
  sh.Range("G3").Resize(k).HorizontalAlignment = xlCenter
  sh.Range("G3").Resize(k).VerticalAlignment = xlCenter
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
End Sub

dạ, em cảm ơn anh ạ.

Bài đã được tự động gộp: Hôm qua, lúc 10:44

LOGANWover đã viết:
Gửi bạn ý tưởng làm Power query, hy vọng giúp được bạn:
View attachment 311074

dạ, em cảm ơn ạ.

DeTong · Hôm qua, lúc 13:23

Có vẻ chưa logic lắm ...
Kết quả đếm sau group

HieuCD · Hôm qua, lúc 14:22

hoaiantrinh đã viết:
Nhờ các anh chị hỗ trợ lọc cụm giá trị duy nhất và đếm số lần xuất hiện của cụm đó, em cảm ơn ạ. Có thể viết hàm hoặc code VBA ạ. Em có gửi file đính kèm

Chỉnh lại code theo kết quả từng nhóm.

Mã:

Sub xyz()
  Dim dic As Object, sh As Worksheet, arr(), res()
  Dim sR&, fRow&, i&, r&, k&, ik&
 
  Set dic = CreateObject("scripting.dictionary")
  Set sh = Sheets("Sheet2")
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  i = sh.Range("F" & Rows.Count).End(xlUp).Row
  If i > 2 Then sh.Range("F3:G" & i).Clear
  arr = sh.Range("A3", sh.Range("C" & Rows.Count).End(xlUp)).Value
  sR = UBound(arr)
  ReDim res(1 To sR, 1 To 4)
  fRow = 3 'Dong dau cua bang ket qua
 
  For i = 1 To sR
    If arr(i, 1) <> Empty Then r = i
    res(r, 3) = res(r, 3) & "|" & arr(i, 3)
    res(r, 4) = res(r, 4) + 1
  Next i
  For i = 1 To sR
    If arr(i, 1) <> Empty Then
      If dic.exists(res(i, 3)) = False Then
        dic.Add res(i, 3), k + 1
        sh.Range("G" & k + fRow).Resize(res(i, 4)).MergeCells = True
        For r = 1 To res(i, 4)
          k = k + 1
          res(k, 1) = arr(i + r - 1, 3)
        Next r
      End If
      ik = dic(res(i, 3))
      res(ik, 2) = res(ik, 2) + 1
    End If
  Next i
 
  sh.Range("F3").Resize(k, 2) = res
  sh.Range("F3").Resize(k, 2).Borders.LineStyle = 1
  sh.Range("G3").Resize(k).HorizontalAlignment = xlCenter
  sh.Range("G3").Resize(k).VerticalAlignment = xlCenter
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
End Sub

hungvinh1402 · Hôm qua, lúc 14:48

Mình góp công thức bạn tham khảo nhé. bạn tham khảo nhé

87kilua · Hôm qua, lúc 22:43

Công thức của người đẹp đây. ..

Mã:

=LET(
    da, B3:B44,
    db, C3:C44,
    ma, UNIQUE(da),
    noib, BYROW(ma, LAMBDA(m, TEXTJOIN(CHAR(10),, SORT(FILTER(db, da=m))))),
    noib_duy, UNIQUE(noib),
    dem, BYROW(noib_duy, LAMBDA(x, SUM(--(noib=x)))),
    VSTACK({"Đầu ra","Trùng"}, HSTACK(noib_duy, dem))
)

Lọc giá trị duy nhất theo cụm (1 người xem)

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

hoaiantrinh

Thành viên mới

File đính kèm

HieuCD

Chuyên gia GPE

LOGANWover

Thành viên chính thức

File đính kèm

hoaiantrinh

Thành viên mới

DeTong

Thành viên thường trực

File đính kèm

HieuCD

Chuyên gia GPE

hungvinh1402

Thành viên mới

File đính kèm

87kilua

Thành viên hoạt động

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

Thời gian đếm ngược.