Ba Tê
Cạo Rồi Khỏi Gội
- Tham gia
- 5/5/09
- Bài viết
- 12,124
- Được thích
- 17,588
- Giới tính
- Nam
Chưa thấy sai trường hợp nào, quanghai cho xem thử với file ví dụ xem.Cũng vậy anh ơi, em cũng đang nhức đầu với cái này.
Chưa thấy sai trường hợp nào, quanghai cho xem thử với file ví dụ xem.Cũng vậy anh ơi, em cũng đang nhức đầu với cái này.
Anh thiếu công đoạn đánh dấu Zero cho Dic.Item khi có trùng (hoặc đánh dấu gì gì cũng được, miễn là có đánh dấu). Mục đích của việc này là để khi trùng lần 1 ta mới "xử", còn trùng lần 2 trờ đi mà "xử" là trật lấtChưa thấy sai trường hợp nào, quanghai cho xem thử với file ví dụ xem.
Cảm ơn Ndu!Anh thiếu công đoạn đánh dấu Zero cho Dic.Item khi có trùng (hoặc đánh dấu gì gì cũng được, miễn là có đánh dấu). Mục đích của việc này là để khi trùng lần 1 ta mới "xử", còn trùng lần 2 trờ đi mà "xử" là trật lất
Ẹc... Ẹc...
Ví dụ dữ liệu thế này nhé:
A1: = "A"
A2, A4, A6 = "B"
A3, A5, A7 = "C"
Test code biết liền ---> Kết quả chính xác sẽ ra 1 kết quả duy nhất là "A"
--------------
Ngoài ra xin nói thêm về cách "biểu diễn" code: Anh liên tục truy xuất Rng(I, 1) như thế là không nên. Trường hợp này nên thông qua 1 biến tmp = Rng(I, 1) sẽ hay hơn ---> Nó là kỹ thuật để tăng tốc đấy!
Public Sub GPE()
Dim Rng(), Dic As Object, I As Long, Arr(), n As Long, K As Long, L As Long, Tem As Variant
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet1
.[E1:E10000].ClearContents
Rng = .[A1:A10000].Value: L = UBound(Rng, 1)
ReDim Arr(1 To L, 1 To 1)
For I = 1 To L
Tem = Rng(I, 1)
If Tem <> "" Then
If Not Dic.Exists(Tem) Then
n = n + 1
Dic.Add Tem, n
Arr(n, 1) = Tem
Else
If Dic.Item(Tem) > 0 Then
K = Dic.Item(Tem)
Dic.Item(Tem) = 0
Arr(K, 1) = Arr(n, 1)
n = n - 1
End If
End If
End If
Next I
If n Then .[E1].Resize(n).Value = Arr
End With
Set Dic = Nothing
End Sub
Vẫn còn thiếu đấyCảm ơn Ndu!
Thú thật là chỉ hiểu cách làm theo giải thích của Ndu chứ đọc code của Ndu mình không hiểu hết "ý đồ" trong đó.
Vì thế hiểu sao làm vậy có thể chưa đúng (bị lỗi trong 1 số trường hợp).
Tạm thêm 1 IF nữa xem sao nhé!
Ái chà, sửa lỗi riết rồi code dài thoòng, nhưng mình tự viết mình mới hiểu.Vẫn còn thiếu đấy
Trước khi cho Dic.Item(tem) = 0 thì phải gán thêm Dic.Item(Arr(n,1)) = k nữa mới xong!
Có nghĩa là:
Gán Item của thằng trùng = 0, đồng thời trước đó phải gán Item cuối cùng bằng số k (là số vừa lấy tại Item trùng)
Thử trường hợp dữ liệu thế này sẽ biết:
A1, A4 = "A"
A3, A6 = "C"
A2 = "B"
A5 = "D"
Kết quả đúng sẽ là "D" và "B"
---------------
Lưu ý chổ màu đỏ nha ---> Nếu đảo ngược trật tự này cũng sẽ sai trong trường hợp thằng trùng nằm ở cuối danh sách
Vậy để tối ưu hóa code, ta nên xét trường hợp k = n (tức thằng trùng nằm cuối danh sách)... khi ấy ta chỉ làm 1 thao tác duy nhất là gán Dic.Item(tem) = 0, bỏ qua vụ gán Dic.Item(Arr(n,1)) = k (giảm việc làm cho code)
Public Sub GPE()
Dim Rng(), I As Long, Arr(), n As Long, K As Long, L As Long, Tem As Variant
With CreateObject("Scripting.Dictionary")
[E1:E10000].ClearContents
Rng = [A1:A10000].Value: L = UBound(Rng, 1)
ReDim Arr(1 To L, 1 To 1)
For I = 1 To L
Tem = Rng(I, 1)
If Tem <> "" Then
If Not .Exists(Tem) Then
n = n + 1
.Add Tem, n
Arr(n, 1) = Tem
Else
If .Item(Tem) > 0 Then
If .Item(Tem) = n Then
.Item(Tem) = 0
n = n - 1
Else
K = .Item(Tem)
.Item(Arr(n, 1)) = K
.Item(Tem) = 0
Arr(K, 1) = Arr(n, 1)
n = n - 1
End If
End If
End If
End If
Next I
If n Then [E1].Resize(n).Value = Arr
End With
End Sub
Anh để ý chổ này:Ái chà, sửa lỗi riết rồi code dài thoòng, nhưng mình tự viết mình mới hiểu.
Hiểu là một chuyện, viết đúng ý muốn hay không lại là chuyện khác.
Híc! Đang 2 For lại "ráng" thành 1 For lại không cho Transpose, "Mệt" thiệt.
Chưa biết nó còn sai trường hợp nào nữa không?
PHP:Public Sub GPE() Dim Rng(), I As Long, Arr(), n As Long, K As Long, L As Long, Tem As Variant With CreateObject("Scripting.Dictionary") [E1:E10000].ClearContents Rng = [A1:A10000].Value: L = UBound(Rng, 1) ReDim Arr(1 To L, 1 To 1) For I = 1 To L Tem = Rng(I, 1) If Tem <> "" Then If Not .Exists(Tem) Then n = n + 1 .Add Tem, n Arr(n, 1) = Tem Else If .Item(Tem) > 0 Then If .Item(Tem) = n Then .Item(Tem) = 0 n = n - 1 Else K = .Item(Tem) .Item(Arr(n, 1)) = K .Item(Tem) = 0 Arr(K, 1) = Arr(n, 1) n = n - 1 End If End If End If End If Next I If n Then [E1].Resize(n).Value = Arr End With End Sub
If .Item(Tem) = n Then
[COLOR=#ff0000].Item(Tem) = 0
n = n - 1[/COLOR]
Else
K = .Item(Tem)
.Item(Arr(n, 1)) = K
[COLOR=#ff0000].Item(Tem) = 0[/COLOR]
Arr(K, 1) = Arr(n, 1)
[COLOR=#ff0000]n = n - 1[/COLOR]
End If
ElseIf .Item(Tem) > 0 Then
K = .Item(Tem)
.Item(Tem) = 0
If K < n Then
.Item(Arr(n, 1)) = K
Arr(K, 1) = Arr(n, 1)
End If
n = n - 1
End If
Đúng vậy.Anh để ý chổ này:
Chổ màu đỏ ấy! Dù điêu kiện IF đúng hay sai thì chúng.. vẫn thế!Mã:If .Item(Tem) = n Then [COLOR=#ff0000].Item(Tem) = 0 n = n - 1[/COLOR] Else K = .Item(Tem) .Item(Arr(n, 1)) = K [COLOR=#ff0000].Item(Tem) = 0[/COLOR] Arr(K, 1) = Arr(n, 1) [COLOR=#ff0000]n = n - 1[/COLOR] End If
Vậy có phải nên cho mấy dòng màu đỏ ấy ra ngoài IF hợp lý hơn không:
So sánh sẽ thấy bây giờ là.. y chang code của em rồiMã:ElseIf .Item(Tem) > 0 Then K = .Item(Tem) .Item(Tem) = 0 If K < n Then .Item(Arr(n, 1)) = K Arr(K, 1) = Arr(n, 1) End If n = n - 1 End If
Ẹc... Ẹc...
------------------
Ngoài ra sau khi chạy vòng lập xong, ta nên phân ra 3 trường hợp xảy ra:
1> Dic.Count = 0 ===> Vùng đang xét là rổng (không có dữ liệu nào)
2> Dic.Count > 0: có 2 trường hợp nhỏ:a> n > 0: Tìm thấy-----------------
b> n = 0: Tất cả dữ liệu đều bị trùng
Bài này anh For Each... sẽ hay hơn vì với vùng nhiều dòng nhiều cột, chẳng lẽ anh phải thêm 1 vòng lập nữa sao?
Anh học code VBA rất nhanh, đây là điều em khâm phục anh nhất (ngày xưa em học chậm như rùa vì tự thấy bản thân kém thông mình)Đúng vậy.
Nhưng đã nói là tự viết, tự sửa mình mới hiểu hết tác dụng của nó, đọc code của người khác thì... hổng hiểu.
Lu xu bu nhưng rất đáng học hỏi.
Cảm ơn Ndu nhé!