Xác định số lần xuất hiện của dữ liệu.

Đỗ Quân · 30/5/24

E chào anh chị !
Hiện tại e đang có 1 vấn đề muốn nhờ ac giúp đỡ ạ. Cụ thể là :
E có 1 file excel chứa rất nhiều dữ liệu lên đến cả 100k dòng. E muốn xác định số lần xuất hiện của các dữ liệu ở cột A xem nó xuất hiện bao nhiêu lần bằng vba vì dùng hàm với dữ liệu nhiều như bảng của e thì máy bị chậm quá ạ.( hàm e đang làm thử ở cột B ạ.) Và dùng hàm countif e thấy có vấn đề là khi dữ liệu dạng như file của e thì hàm xác định sai ạ. Do dữ liệu của e lớn hơn 15 ký tự và viết liền ko có chữ ạ.
Mong a chị giúp e vấn đề này ạ. Em cảm ơn !

CHAOQUAY · 30/5/24

Đỗ Quân đã viết:
E chào anh chị !
Hiện tại e đang có 1 vấn đề muốn nhờ ac giúp đỡ ạ. Cụ thể là :
E có 1 file excel chứa rất nhiều dữ liệu lên đến cả 100k dòng. E muốn xác định số lần xuất hiện của các dữ liệu ở cột A xem nó xuất hiện bao nhiêu lần bằng vba vì dùng hàm với dữ liệu nhiều như bảng của e thì máy bị chậm quá ạ.( hàm e đang làm thử ở cột B ạ.) Và dùng hàm countif e thấy có vấn đề là khi dữ liệu dạng như file của e thì hàm xác định sai ạ. Do dữ liệu của e lớn hơn 15 ký tự và viết liền ko có chữ ạ.
Mong a chị giúp e vấn đề này ạ. Em cảm ơn !

Test thử xem sao

Mã:

Option Explicit

Sub xxx()
Dim Nguon
Dim mTK() As Long
Dim mKq()
Dim i, j, k

Nguon = Sheet1.Range("A2", Sheet1.Range("A2").End(xlDown))
k = UBound(Nguon)
ReDim mTK(k, 1)
ReDim mKq(1 To k, 1 To 1)

With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(Nguon)
        If .exists(Nguon(i, 1)) Then
            k = .Item(Nguon(i, 1))
        Else
            k = .Count
            .Item(Nguon(i, 1)) = k
        End If
        mTK(k, 1) = mTK(k, 1) + 1
        mTK(k, 0) = mTK(k, 0) + 1
    Next i
    
    For i = UBound(Nguon) To 1 Step -1
        k = .Item(Nguon(i, 1))
        If mTK(k, 0) = 1 And mTK(k, 1) = 1 Then
            mKq(i, 1) = "lan cuoi"
        Else
            j = mTK(k, 0)
            mTK(k, 0) = mTK(k, 0) - 1
            mKq(i, 1) = "lan " & j
        End If
    Next i
End With

With Sheet1
    .Range("C2").Resize(UBound(mKq), UBound(mKq, 2)) = mKq
End With
End Sub

Đỗ Quân · 30/5/24

CHAOQUAY đã viết:

Test thử xem sao

Mã:

Option Explicit

Sub xxx()
Dim Nguon
Dim mTK() As Long
Dim mKq()
Dim i, j, k

Nguon = Sheet1.Range("A2", Sheet1.Range("A2").End(xlDown))
k = UBound(Nguon)
ReDim mTK(k, 1)
ReDim mKq(1 To k, 1 To 1)

With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(Nguon)
        If .exists(Nguon(i, 1)) Then
            k = .Item(Nguon(i, 1))
        Else
            k = .Count
            .Item(Nguon(i, 1)) = k
        End If
        mTK(k, 1) = mTK(k, 1) + 1
        mTK(k, 0) = mTK(k, 0) + 1
    Next i
   
    For i = UBound(Nguon) To 1 Step -1
        k = .Item(Nguon(i, 1))
        If mTK(k, 0) = 1 And mTK(k, 1) = 1 Then
            mKq(i, 1) = "lan cuoi"
        Else
            j = mTK(k, 0)
            mTK(k, 0) = mTK(k, 0) - 1
            mKq(i, 1) = "lan " & j
        End If
    Next i
End With

With Sheet1
    .Range("C2").Resize(UBound(mKq), UBound(mKq, 2)) = mKq
End With
End Sub

Vâng e chào a a. E đã test thử và thấy số lần có chút chưa đúng a ạ.phần e khoang đỏ là vba chạy ra ạm con bên cạnh là hàm ạ. Data xuất hiện 4 lần nên lần 4 e muốn trả về là lần cuối ạ.

CHAOQUAY · 30/5/24

Đỗ Quân đã viết:
Vâng e chào a a. E đã test thử và thấy số lần có chút chưa đúng a ạ.phần e khoang đỏ là vba chạy ra ạm con bên cạnh là hàm ạ. Data xuất hiện 4 lần nên lần 4 e muốn trả về là lần cuối ạ.

Bạn xem lại công thức tại B2 file bài 1 rồi giải thích xem tại sao kết quả lại là "lan cuoi" vậy

Bài đã được tự động gộp: 30/5/24

Đỗ Quân đã viết:
Vâng e chào a a. E đã test thử và thấy số lần có chút chưa đúng a ạ.phần e khoang đỏ là vba chạy ra ạm con bên cạnh là hàm ạ. Data xuất hiện 4 lần nên lần 4 e muốn trả về là lần cuối ạ.

Tìm dòng trên, thay = dòng dưới rồi test lại xem sao

Mã:

'If mTK(k, 0) = 1 And mTK(k, 1) = 1 Then
 If mTK(k, 0) = mTK(k, 1) Then

Đỗ Quân · 30/5/24

CHAOQUAY đã viết:
Bạn xem lại công thức tại B2 file bài 1 rồi giải thích xem tại sao kết quả lại là "lan cuoi" vậy

Bài đã được tự động gộp: 30/5/24

Tìm dòng trên, thay = dòng dưới rồi test lại xem sao

Mã:

'If mTK(k, 0) = 1 And mTK(k, 1) = 1 Then If mTK(k, 0) = mTK(k, 1) Then[/CODnos đ [/QUOTE]

Nó trả về toàn bộ là dòng cuối ạ.

Bài đã được tự động gộp: 30/5/24

CHAOQUAY đã viết:
Bạn xem lại công thức tại B2 file bài 1 rồi giải thích xem tại sao kết quả lại là "lan cuoi" vậy

Bài đã được tự động gộp: 30/5/24

Tìm dòng trên, thay = dòng dưới rồi test lại xem sao

Mã:

'If mTK(k, 0) = 1 And mTK(k, 1) = 1 Then If mTK(k, 0) = mTK(k, 1) Then

Công thức ở b2 của e là sẽ đếm số dữ liệu từ trên xuống dưới khi phía dưới nó ko còn data trùng nó thì nó sẽ trả về là lần cuối ạ.

CHAOQUAY · 30/5/24

Đỗ Quân đã viết:
Nó trả về toàn bộ là dòng cuối ạ.

Bài đã được tự động gộp: 30/5/24

Công thức ở b2 của e là sẽ đếm số dữ liệu từ trên xuống dưới khi phía dưới nó ko còn data trùng nó thì nó sẽ trả về là lần cuối ạ.

Chắc là thế này.

Mã:

Option Explicit


Sub xxx()
Dim Nguon
Dim mTK() As Long
Dim mKq()
Dim i, j, k

Nguon = Sheet1.Range("A2", Sheet1.Range("A2").End(xlDown))
k = UBound(Nguon)
ReDim mTK(k, 1)
ReDim mKq(1 To k, 1 To 1)

With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(Nguon)
        If .exists(Nguon(i, 1)) Then
            k = .Item(Nguon(i, 1))
        Else
            k = .Count
            .Item(Nguon(i, 1)) = k
        End If
        mTK(k, 1) = mTK(k, 1) + 1
        mTK(k, 0) = mTK(k, 0) + 1
    Next i
    
    For i = UBound(Nguon) To 1 Step -1
        k = .Item(Nguon(i, 1))
        If mTK(k, 0) = mTK(k, 1) Then
            mKq(i, 1) = "lan cuoi"
        Else
            j = mTK(k, 0)
            mKq(i, 1) = "lan " & j
        End If
        mTK(k, 0) = mTK(k, 0) - 1
    Next i
End With

With Sheet1
    .Range("C2").Resize(UBound(mKq), UBound(mKq, 2)) = mKq
End With
End Sub

Đỗ Quân · 30/5/24

CHAOQUAY đã viết:

Chắc là thế này.

Mã:

Option Explicit


Sub xxx()
Dim Nguon
Dim mTK() As Long
Dim mKq()
Dim i, j, k

Nguon = Sheet1.Range("A2", Sheet1.Range("A2").End(xlDown))
k = UBound(Nguon)
ReDim mTK(k, 1)
ReDim mKq(1 To k, 1 To 1)

With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(Nguon)
        If .exists(Nguon(i, 1)) Then
            k = .Item(Nguon(i, 1))
        Else
            k = .Count
            .Item(Nguon(i, 1)) = k
        End If
        mTK(k, 1) = mTK(k, 1) + 1
        mTK(k, 0) = mTK(k, 0) + 1
    Next i
   
    For i = UBound(Nguon) To 1 Step -1
        k = .Item(Nguon(i, 1))
        If mTK(k, 0) = mTK(k, 1) Then
            mKq(i, 1) = "lan cuoi"
        Else
            j = mTK(k, 0)
            mKq(i, 1) = "lan " & j
        End If
        mTK(k, 0) = mTK(k, 0) - 1
    Next i
End With

With Sheet1
    .Range("C2").Resize(UBound(mKq), UBound(mKq, 2)) = mKq
End With
End Sub

Dạ. Quá chính xác rồi ạ. E cảm ơn ạ !!!!

VetMini · 31/5/24

Lý do chạy chậm là vì công thức dò cả cột (trên 1 triệu dòng)
VBA chỉ là đắp vá cho qua nạn.

Bảng này (như trong ví dụ) đọc bằng cách nào tôi chịu thua. Nhìn "lần cuối", đâu có biết nó còn lần nào khác? Và nhìn "lần 2" đâu có biết nó còn "lần 3 (4 lặp)" hay "lần cuối (3 lặp)" ? Như vậy yêu cầu "xem nó xuất hiện bao nhiêu lần" đâu có ý nghĩa gì?

snow25 · 31/5/24

Đỗ Quân đã viết:
E chào anh chị !
Hiện tại e đang có 1 vấn đề muốn nhờ ac giúp đỡ ạ. Cụ thể là :
E có 1 file excel chứa rất nhiều dữ liệu lên đến cả 100k dòng. E muốn xác định số lần xuất hiện của các dữ liệu ở cột A xem nó xuất hiện bao nhiêu lần bằng vba vì dùng hàm với dữ liệu nhiều như bảng của e thì máy bị chậm quá ạ.( hàm e đang làm thử ở cột B ạ.) Và dùng hàm countif e thấy có vấn đề là khi dữ liệu dạng như file của e thì hàm xác định sai ạ. Do dữ liệu của e lớn hơn 15 ký tự và viết liền ko có chữ ạ.
Mong a chị giúp e vấn đề này ạ. Em cảm ơn !

Thử code này hên sui.

Mã:

Sub abc()
    Dim i As Long, lr As Long, dic As Object, arr, kq, dk As String, b As Long, c As Integer
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("sheet1")
        lr = .Range("A" & Rows.Count).End(xlUp).Row
        arr = .Range("A2:A" & lr).Value
        ReDim kq(1 To UBound(arr), 1 To 1)
        For i = 1 To UBound(arr)
            dk = arr(i, 1)
            If Not dic.exists(dk) Then
               dic.Add dk, Array(i, 1)
               kq(i, 1) = "lan cuoi"
            Else
               b = dic.Item(dk)(0)
               c = dic.Item(dk)(1)
               kq(b, 1) = c
               kq(i, 1) = "lan cuoi"
               dic.Item(dk) = Array(i, c + 1)
            End If
        Next i
        .Range("B2:B" & lr).Value = kq
    End With
    Set dic = Nothing
End Sub

VetMini · 31/5/24

Trình bày kiểu như đánh số trang mới đọc được
VD: 1 (5), 2 (5), 3 (5), 4 (5), 5 (5)

Công nhận công thức bài này rắc rối thật. Theo công thức thì Excel trên máy tôi báo chạy cả 12 luồng, khoảng 20 giây thì xong. (nhưng bảo lâu thì quan niệm của tôi ít nhất phải trên 10 phút mới gọi là lâu, tức trên 10 phút mới phải nghĩ đến code)

Phuocam · 31/5/24

VetMini đã viết:
Trình bày kiểu như đánh số trang mới đọc được
VD: 1 (5), 2 (5), 3 (5), 4 (5), 5 (5)

Làm theo yêu cầu này nè:

Mã:

Sub Test()
Dim Nguon, mKq
Dim i&, j&, k&, t
't = Timer
Nguon = Sheet1.Range("A2", Sheet1.Range("A2").End(xlDown)).Value
k = UBound(Nguon)
ReDim mKq(1 To k, 1 To 1)

With CreateObject("Scripting.Dictionary")
    For i = 1 To k
        j = .Item(Nguon(i, 1)) + 1
        .Item(Nguon(i, 1)) = j
         mKq(i, 1) = j
    Next i
    
     For i = 1 To k
        mKq(i, 1) = mKq(i, 1) & " (" & .Item(Nguon(i, 1)) & ")"
    Next i
End With

With Sheet1
    .Range("B2").Resize(k, 1) = mKq
End With
'MsgBox Timer - t
End Sub

Đỗ Quân · 31/5/24

VetMini đã viết:
Lý do chạy chậm là vì công thức dò cả cột (trên 1 triệu dòng)
VBA chỉ là đắp vá cho qua nạn.

Bảng này (như trong ví dụ) đọc bằng cách nào tôi chịu thua. Nhìn "lần cuối", đâu có biết nó còn lần nào khác? Và nhìn "lần 2" đâu có biết nó còn "lần 3 (4 lặp)" hay "lần cuối (3 lặp)" ? Như vậy yêu cầu "xem nó xuất hiện bao nhiêu lần" đâu có ý nghĩa gì?

Thực tế là bài này còn rất nhiều ỹ phải lm nữa ạ. Nhưng e chỉ mắc ở chỗ xđ số lần của từng data ạ. Còn những phần khác e đã giải quyết đc ạ. Cảm ơn m.n đã giúp e nhiệt tình ạ

Bài đã được tự động gộp: 31/5/24

snow25 đã viết:

Thử code này hên sui.

Mã:

Sub abc()
    Dim i As Long, lr As Long, dic As Object, arr, kq, dk As String, b As Long, c As Integer
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("sheet1")
        lr = .Range("A" & Rows.Count).End(xlUp).Row
        arr = .Range("A2:A" & lr).Value
        ReDim kq(1 To UBound(arr), 1 To 1)
        For i = 1 To UBound(arr)
            dk = arr(i, 1)
            If Not dic.exists(dk) Then
               dic.Add dk, Array(i, 1)
               kq(i, 1) = "lan cuoi"
            Else
               b = dic.Item(dk)(0)
               c = dic.Item(dk)(1)
               kq(b, 1) = c
               kq(i, 1) = "lan cuoi"
               dic.Item(dk) = Array(i, c + 1)
            End If
        Next i
        .Range("B2:B" & lr).Value = kq
    End With
    Set dic = Nothing
End Sub

E cảm ơn m.b đã hỗ trợ e nhiệt tình ạ

Bài đã được tự động gộp: 31/5/24

Phuocam đã viết:

Làm theo yêu cầu này nè:

Mã:

Sub Test()
Dim Nguon, mKq
Dim i&, j&, k&, t
't = Timer
Nguon = Sheet1.Range("A2", Sheet1.Range("A2").End(xlDown)).Value
k = UBound(Nguon)
ReDim mKq(1 To k, 1 To 1)

With CreateObject("Scripting.Dictionary")
    For i = 1 To k
        j = .Item(Nguon(i, 1)) + 1
        .Item(Nguon(i, 1)) = j
         mKq(i, 1) = j
    Next i
   
     For i = 1 To k
        mKq(i, 1) = mKq(i, 1) & " (" & .Item(Nguon(i, 1)) & ")"
    Next i
End With

With Sheet1
    .Range("B2").Resize(k, 1) = mKq
End With
'MsgBox Timer - t
End Sub

Em cảm ơn m.n nhiều ạ

Bài đã được tự động gộp: 31/5/24

VetMini đã viết:
Trình bày kiểu như đánh số trang mới đọc được
VD: 1 (5), 2 (5), 3 (5), 4 (5), 5 (5)

Công nhận công thức bài này rắc rối thật. Theo công thức thì Excel trên máy tôi báo chạy cả 12 luồng, khoảng 20 giây thì xong. (nhưng bảo lâu thì quan niệm của tôi ít nhất phải trên 10 phút mới gọi là lâu, tức trên 10 phút mới phải nghĩ

VetMini đã viết:
Trình bày kiểu như đánh số trang mới đọc được
VD: 1 (5), 2 (5), 3 (5), 4 (5), 5 (5)

Công nhận công thức bài này rắc rối thật. Theo công thức thì Excel trên máy tôi báo chạy cả 12 luồng, khoảng 20 giây thì xong. (nhưng bảo lâu thì quan niệm của tôi ít nhất phải trên 10 phút mới gọi là lâu, tức trên 10 phút mới

Data này e phải sử lý nhiều lần trong một ngày nên e muốn nó chạy nhanh hơn xíu. Ở máy e để công thức khi data lên 100k dòng thì máy chạy mất tầm 4-5p. Nên e muốn cải tiến bằng vba để tăng hiệu xuất lm việc ạ

Xác định số lần xuất hiện của dữ liệu.

Đỗ Quân

Thành viên mới

File đính kèm

CHAOQUAY

CHAOQUAY

Thành viên gắn bó

Đỗ Quân

Thành viên mới

File đính kèm

CHAOQUAY

Thành viên gắn bó

Đỗ Quân

Thành viên mới

File đính kèm

CHAOQUAY

Thành viên gắn bó

Đỗ Quân

Thành viên mới

VetMini

Ăn cùng góc phố

snow25

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

VetMini

Ăn cùng góc phố

Phuocam

Thành viên mới

Đỗ Quân

Thành viên mới

Bài viết mới nhất

Facebook

Group

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