Nhờ chỉnh code lấy duy nhất

[eke_rula]

Em có đoạn code này :

Function khongtrung3(rng As Range)
Dim arr(), sarr(), i As Long, j As Long, k As Long, l As Long, text As String
arr = rng.Value
ReDim sarr(1 To UBound(arr), 1 To UBound(arr, 2))
With CreateObject("scripting.dictionary")
    For i = 1 To UBound(arr)
        For j = 1 To UBound(arr, 2)
            text = text & arr(i, j)
        Next j
        If Len(text) > 0 And Not .exists(text) Then
            j = j + 1: .Add text, ""
            For l = 1 To UBound(arr, 2)
                sarr(i, l) = arr(i, l)
            Next l
        End If
        text = ""
    Next i
End With
If j > 0 Then khongtrung3 = sarr
End Function

Sau khi chạy thử em thấy là mảng tạo ra bằng với mảnh ban đầu đưa vào, mặc dù lấy được duy nhất nhưng có những ô cuối =0, nếu em bỏ dòng ReDim sarr(1 To UBound(arr), 1 To UBound(arr, 2)) thì lại bị lỗi, nhờ các anh chị chỉnh lại code dùm em, để nó lấy đúng vùng được tạo ra thôi ạ, em cám ơn!!!

 

[VetMini]

Anh cho em hỏi tý, cái đoạn này i = .Items()(itm) mình bỏ được không anh, nếu bỏ ra mình có thể viết Sarr(itm+1, j) = arr(itm+1, j) được đúng không anh, vì em nghĩ đã xác định được số dòng của mảng tạo ra rồi (.count) thì cứ thế duyệt thôi, đâu cần phải tìm lại item trong dic, vậy cái đoạn đó đưa vào có tác dụng gì vậy anh!!!

Không được, i không giống itm
.Items() trả về 1 mảng (*) các dòng dữ liệu trong Dictionary; Phép toán (itm) truy lấy phần tử thứ itm của mảng này; Phép toán i= gán trị ấy vào i
Như vậy sau cả dòng lệnh thì i sẽ chứa chỉ số dòng liên hệ trong mảng arr
Sarr(itm+1, j) = arr(i, j) là chéps từ dòng i bên arr (dòng liên hệ) sang dòng itm+1 bên Sarr (itm bắt đầu từ 0 nên phải +1)
Nếu code thực sự có lọc duy nhất thì thường thường trị itm+1 sẽ nhỏ hơn i

(*) như tôi đã giải thích ở trên, Items khong hẳn là mảng nhưng có thể tạm côi là mảng ở một vài điểm tính toán.