ĐẾM SỐ LẦN XUẤT HIỆN CỦA PHẦN TỬ (1 người xem)

[hcl_pt]

Mong GPE giúp đỡ mình trường hợp sau có phương án nào thực hiện nhanh nhất không?
- Cột phần tử: có các phần tử bất kì cho trước
- Cột dữ liệu: có các dữ liệu bất kì cho trước
=> Yêu cầu: đếm số lần của các phần tử xuất hiện có trong cột dữ liệu, kết quả dán vào cột số lần xuất hiện tương ứng.
Ví dụ: phần tử 0 xuất hiện 2 lần trong cột Dữ liệu nên được đếm 2 lần và điền vào cột số lần xuất hiện.
- Rất mong các anh chị trong GPE giúp đỡ! Xin trân trọng cảm ơn!

 

[CHAOQUAY]

Mong GPE giúp đỡ mình trường hợp sau có phương án nào thực hiện nhanh nhất không?
- Cột phần tử: có các phần tử bất kì cho trước
- Cột dữ liệu: có các dữ liệu bất kì cho trước
=> Yêu cầu: đếm số lần của các phần tử xuất hiện có trong cột dữ liệu, kết quả dán vào cột số lần xuất hiện tương ứng.
Ví dụ: phần tử 0 xuất hiện 2 lần trong cột Dữ liệu nên được đếm 2 lần và điền vào cột số lần xuất hiện.
- Rất mong các anh chị trong GPE giúp đỡ! Xin trân trọng cảm ơn!

Thử

C4=COUNTIF($E$4:$E$24,B4)

 

[hcl_pt]

Thử

C4=COUNTIF($E$4:$E$24,B4)

Dạ, cảm ơn bạn! Ngoài công thức ra có thể dùng code được không ạ?

 

[Ba Tê]

Dạ, cảm ơn bạn! Ngoài công thức ra có thể dùng code được không ạ?

Sửa lại tiêu đề bài viết, đừng viết HOA cả câu.

Public Sub GPE()
Dim sArr(), dArr(), I As Long, K As Long, xMax As Long, R As Long
    R = Range("E1000000").End(xlUp).Row
    xMax = Application.WorksheetFunction.Max(Range("E4:E" & R))
    ReDim dArr(1 To xMax + 1, 1 To 2)
With CreateObject("Scripting.Dictionary")
    For I = 0 To xMax
        K = K + 1
        .Item(I) = K
        dArr(K, 1) = I
        dArr(K, 2) = 0
    Next I
    '------------------------------------'
    sArr = Range("E4:E" & R).Value
    R = UBound(sArr)
    For I = 1 To R
        dArr(.Item(sArr(I, 1)), 2) = dArr(.Item(sArr(I, 1)), 2) + 1
    Next I
End With
Range("B4").Resize(K, 2) = dArr
End Sub

 

[CHAOQUAY]

Dạ, cảm ơn bạn! Ngoài công thức ra có thể dùng code được không ạ?

Nếu số liệu cột B sắp xếp tăng dần liên tục & bắt đầu từ 0 thì có thể dùng code sau

Sub dem()
Dim dulieu, phantu
Dim i, j, k
phantu = Sheet1.Range("B4", Sheet1.Range("B4").End(xlDown))
dulieu = Sheet1.Range("E4", Sheet1.Range("E4").End(xlDown))
k = UBound(phantu) - 1
ReDim Preserve phantu(1 To k + 1, 1 To 2)
For i = 1 To UBound(dulieu)
    j = dulieu(i, 1)
    If j <= k Then
        phantu(j + 1, 2) = phantu(j + 1, 2) + 1
    End If
Next i
Sheet1.Range("B4").Resize(k + 1, 2) = phantu
End Sub