Code Đếm theo tên hàng không phân biệt chữ hoa chữ Thường

[Phúc Lộc Thọ]

Em xin chào đại gia đình, Em cần code đếm theo tên hàng ( dạng mãng ) tại dữ liệu em 20.000 dòng nên không thể dùng công thức countif được. Em tập tành viết tới đoạn này bí luôn rồi. Nhờ mọi người bổ sung code hoặc viết 1 code mới phù hợp. em xin cảm ơn đại gia đình


Sub dem()
Dim arr(), i&
arr = Range("B5:B15").Value
For i = 1 To UBound(arr)
If arr(i, 1) <> "" Then
' chổ này Em bí . không biết dùng gì để đếm
End If
Next
Range("c5").Resize(UBound(arr)).Value = arr
End Sub

 

[Nhattanktnn]

Em xin chào đại gia đình, Em cần code đếm theo tên hàng ( dạng mãng ) tại dữ liệu em 20.000 dòng nên không thể dùng công thức countif được. Em tập tành viết tới đoạn này bí luôn rồi. Nhờ mọi người bổ sung code hoặc viết 1 code mới phù hợp. em xin cảm ơn đại gia đình


Sub dem()
Dim arr(), i&
arr = Range("B5:B15").Value
For i = 1 To UBound(arr)
If arr(i, 1) <> "" Then
' chổ này Em bí . không biết dùng gì để đếm
End If
Next
Range("c5").Resize(UBound(arr)).Value = arr
End Sub


View attachment 280370

Đếm này dùng dictionary là dễ nhất, mà giờ trễ quá rồi. Mai chưa ai giúp thì tôi giúp!

 

[Phúc Lộc Thọ]

Đếm này dùng dictionary là dễ nhất, mà giờ trễ quá rồi. Mai chưa ai giúp thì tôi giúp!

Dạ Em xin chân thành cảm ơn anh . Có gì mai anh giúp em nhé. em cũng đang học nên không rành cho lắm

 

[Phuocam]

Em xin chào đại gia đình, Em cần code đếm theo tên hàng ( dạng mãng ) tại dữ liệu em 20.000 dòng nên không thể dùng công thức countif được. Em tập tành viết tới đoạn này bí luôn rồi. Nhờ mọi người bổ sung code hoặc viết 1 code mới phù hợp. em xin cảm ơn đại gia đình


Sub dem()
Dim arr(), i&
arr = Range("B5:B15").Value
For i = 1 To UBound(arr)
If arr(i, 1) <> "" Then
' chổ này Em bí . không biết dùng gì để đếm
End If
Next
Range("c5").Resize(UBound(arr)).Value = arr
End Sub


View attachment 280370

Thử code này

Sub dem()
Dim arr(), i&
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
arr = Range("B5:B15").Value

'Dem
For i = 1 To UBound(arr)
    If arr(i, 1) <> "" Then
        arr(i, 1) = UCase(arr(i, 1))
        dic.Item(arr(i, 1)) = dic.Item(arr(i, 1)) + 1
    End If
Next

'Gan gia tri
For i = 1 To UBound(arr)
    If arr(i, 1) <> "" Then
        arr(i, 1) = dic.Item(arr(i, 1))
    End If
Next
Range("c5").Resize(UBound(arr)).Value = arr
End Sub

 

[Phúc Lộc Thọ]

Thử code này

Sub dem()
Dim arr(), i&
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
arr = Range("B5:B15").Value

'Dem
For i = 1 To UBound(arr)
    If arr(i, 1) <> "" Then
        arr(i, 1) = UCase(arr(i, 1))
        dic.Item(arr(i, 1)) = dic.Item(arr(i, 1)) + 1
    End If
Next

'Gan gia tri
For i = 1 To UBound(arr)
    If arr(i, 1) <> "" Then
        arr(i, 1) = dic.Item(arr(i, 1))
    End If
Next
Range("c5").Resize(UBound(arr)).Value = arr
End Sub

Code quá đúng ý Mình Luôn. cảm ơn bạn rất nhiều

 

[Nhattanktnn]

Dạ Em xin chân thành cảm ơn anh . Có gì mai anh giúp em nhé. em cũng đang học nên không rành cho lắm

Lỡ viết xong thấy có bài sẵn trên rồi nên gửi luôn:

Sub dem()
    Dim Arr(), Dic As Object, I&, iKey$
    Set Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = vbTextCompare
    With Sheets("code1")
        Arr = .Range("B5:B" & .Cells(Rows.Count, "B").End(xlUp).Row).Value
        For I = 1 To UBound(Arr)
            iKey = Arr(I, 1)
            If iKey <> vbNullString Then Dic(iKey) = Dic(iKey) + 1
        Next
        For I = 1 To UBound(Arr)
            iKey = Arr(I, 1)
            If iKey <> vbNullString Then Arr(I, 1) = Dic(iKey)
        Next
        .Range("C5").Resize(Rows.Count - 10).ClearContents
        .Range("C5").Resize(UBound(Arr)).Value = Arr
    End With
End Sub

arr(i, 1) = UCase(arr(i, 1))

Bài bác Phước để Dic.CompareMode = vbTextCompare thì đẹp hơn

 

[huhumalu]

Có chút thắc mắc với chủ "thớt" là nếu đếm sự xuất hiện xong chỉ điền vào ô bên cạnh thì xài kiểu gì ta
Sau khi có kết quả nhờ 2 bài #4 và #6 thì làm gì tiếp, lại quét 2 vòng for sao ?
Mình nghĩ sau khi làm xong các động tác trên thì cần thu về các Items không trùng của cột B và số lần xuất hiện chứ ?