Xin hỏi về Code VBA lọc dữ liệu trùng nhau

[syquyen1987]

Mình đang học thêm VBA, các bạn cho mình hỏi cách giải bài này với:
Những ô trùng nhau sẽ thêm thứ tự tăng dần từ 1 đến n, nếu ô không trùng nhau sẽ để nguyên trạng. Đây là code mình viết nhưng chạy chưa đạt yêu cầu. Nhờ mọi người chỉ giúp

Sub asss()
lr = Range("A" & Rows.Count).End(xlUp).Row
arr = Range("A2:A" & lr).Value
ReDim brr(1 To UBound(arr), 1 To 1)
Set dic = CreateObject("scripting.dictionary")

For i = 1 To UBound(arr)
dk = arr(i, 1)
If Not dic.exists(dk) Then
a = a + 1
dic.Add (dk), 1
brr(a, 1) = arr(i, 1)
Else
b = dic.Item(dk)
b = b + 1
a = a + 1
brr(a, 1) = arr(i, 1) & b
dic.Item(dk) = b
End If
Next i
Range("B2").Resize(a) = brr
End Sub

Nếu mà If Not dic.exists(dk) mà mình thêm brr(a, 1) = arr(i, 1) & 1 thì các ô không có dữ liệu trùng nhau thì sẽ không nguyên trạng nữa (vì kèm theo 1)

 

[giaiphap]

Mình đang học thêm VBA, các bạn cho mình hỏi cách giải bài này với:
Những ô trùng nhau sẽ thêm thứ tự tăng dần từ 1 đến n, nếu ô không trùng nhau sẽ để nguyên trạng. Đây là code mình viết nhưng chạy chưa đạt yêu cầu. Nhờ mọi người chỉ giúp
View attachment 243318
Sub asss()
lr = Range("A" & Rows.Count).End(xlUp).Row
arr = Range("A2:A" & lr).Value
ReDim brr(1 To UBound(arr), 1 To 1)
Set dic = CreateObject("scripting.dictionary")

For i = 1 To UBound(arr)
dk = arr(i, 1)
If Not dic.exists(dk) Then
a = a + 1
dic.Add (dk), 1
brr(a, 1) = arr(i, 1)
Else
b = dic.Item(dk)
b = b + 1
a = a + 1
brr(a, 1) = arr(i, 1) & b
dic.Item(dk) = b
End If
Next i
Range("B2").Resize(a) = brr
End Sub

Nếu mà If Not dic.exists(dk) mà mình thêm brr(a, 1) = arr(i, 1) & 1 thì các ô không có dữ liệu trùng nhau thì sẽ không nguyên trạng nữa (vì kèm theo 1)

Sửa code lại thế này

Sub asss()
Dim i&, j&, lr&, b&, Dic As Object, Arr, Brr, dk$
lr = Range("A" & Rows.Count).End(xlUp).Row
Arr = Range("A2:A" & lr).Value
ReDim Brr(1 To UBound(Arr), 1 To 1)
Set Dic = CreateObject("scripting.dictionary")
For i = 1 To UBound(Arr)
    dk = Arr(i, 1)
    If Not Dic.exists(dk) Then
        Dic.Add (dk), Format(i, "00000") & "001"
        Brr(i, 1) = Arr(i, 1)
    Else
        b = Val(Right(Dic.Item(dk), 3)) + 1
        j = Val(Left(Dic.Item(dk), 5))
        If b = 2 Then Brr(j, 1) = Brr(j, 1) & 1
        Dic.Item(dk) = Format(i, "00000") & Format(b, "000")
        Brr(i, 1) = dk & b
    End If
Next i
Range("B2").Resize(UBound(Arr)) = Brr
Set Dic = Nothing
End Sub

 

[syquyen1987]

Sửa code lại thế này

Sub asss()
Dim i&, j&, lr&, b&, Dic As Object, Arr, Brr, dk$
lr = Range("A" & Rows.Count).End(xlUp).Row
Arr = Range("A2:A" & lr).Value
ReDim Brr(1 To UBound(Arr), 1 To 1)
Set Dic = CreateObject("scripting.dictionary")
For i = 1 To UBound(Arr)
    dk = Arr(i, 1)
    If Not Dic.exists(dk) Then
        Dic.Add (dk), Format(i, "00000") & "001"
        Brr(i, 1) = Arr(i, 1)
    Else
        b = Val(Right(Dic.Item(dk), 3)) + 1
        j = Val(Left(Dic.Item(dk), 5))
        If b = 2 Then Brr(j, 1) = Brr(j, 1) & 1
        Dic.Item(dk) = Format(i, "00000") & Format(b, "000")
        Brr(i, 1) = dk & b
    End If
Next i
Range("B2").Resize(UBound(Arr)) = Brr
Set Dic = Nothing
End Sub

Hoàn hảo!, bạn có thể giải thích cho mình mấu chốt vấn đề được không vậy? Minh xin cám ơn

 

[tigertiger]

Hoàn hảo!, bạn có thể giải thích cho mình mấu chốt vấn đề được không vậy? Minh xin cám ơn

Mấu chốt là tìm hiểu kỹ lại về object Dictionary (đối tượng dictionary)

 

[giaiphap]

Hoàn hảo!, bạn có thể giải thích cho mình mấu chốt vấn đề được không vậy? Minh xin cám ơn

Tôi giải thích 2 chổ, còn cái khác e rằng bạn đã biết.
Thứ nhất.

Dic.Add (dk), Format(i, "00000") & "001"

Thêm Key dk vào trong Dic với giá trị là số thứ tự i và số lần xuát hiện 1.
Thứ hai:

        b = Val(Right(Dic.Item(dk), 3)) + 1
        j = Val(Left(Dic.Item(dk), 5))
        If b = 2 Then Brr(j, 1) = Brr(j, 1) & 1
        Dic.Item(dk) = Format(i, "00000") & Format(b, "000")

Nếu Key đã tồn tại rồi thì đọc lại vị trí trùng đó và gán vào biến j (Thứ tự) và biến b (Số lượng) + 1.
Nếu b =2 thì đây là lần gặp lại Key lần thứ 2, lúc đó ta trở lại vị trí j và cập nhật lại giá trị ban đầu kèm theo số 1 phía sau.
Cập nhật lại giá trị của Key dk là vị trí i và số lượng b.[/code]