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

eke_rula · 15/6/17

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

Mã:

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!!!

befaint · 15/6/17

eke_rula đã viết:
Em có đoạn code này :

Mã:

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!!!

PHP:

Function khongtrung3(rng As Range)
Dim arr(), sarr(), i As Long, j As Long, k As Long, ii 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
            ii = ii + 1: .Add text, ""
            For k = 1 To UBound(arr, 2)
                sarr(ii, k) = arr(i, k)
            Next k
        End If
        text = ""
    Next i
End With
If ii > 0 Then
    ReDim arrTemp(1 To ii, 1 To UBound(sarr, 2))
    For i = 1 To ii
        For k = 1 To UBound(sarr, 2)
            arrTemp(i, k) = sarr(i, k)
        Next k
    Next i
    khongtrung3 = arrTemp
End If
End Function

eke_rula · 15/6/17

befaint đã viết:

PHP:

Function khongtrung3(rng As Range)
Dim arr(), sarr(), i As Long, j As Long, k As Long, ii 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
            ii = ii + 1: .Add text, ""
            For k = 1 To UBound(arr, 2)
                sarr(ii, k) = arr(i, k)
            Next k
        End If
        text = ""
    Next i
End With
If ii > 0 Then
    ReDim arrTemp(1 To ii, 1 To UBound(sarr, 2))
    For i = 1 To ii
        For k = 1 To UBound(sarr, 2)
            arrTemp(i, k) = sarr(i, k)
        Next k
    Next i
    khongtrung3 = arrTemp
End If
End Function

Anh tạo ra một mảng nữa, đã hiểu vấn đề, cám ơn anh!!!

VetMini · 15/6/17

eke_rula đã viết:
Em có đoạn code này :

Mã:

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) ' ---- lưu ý 1: đoạn code này thay đổi giá trị của j text = text & arr(i, j) Next j If Len(text) > 0 And Not .exists(text) Then j = j + 1: .Add text, "" ' ---- lưu ý 2: đoạn code này dùng j để đếm số dòng, nhưng j bị thay đổi ở đoạn trên rồi 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!!!

Dạng code này nhìn quen lắm. Quen ở chỗ đám i, j, k, l
Thường thường tác giả dùng k để đếm số dòng sử dụng. Code của bạn bị lẫn nó thành j.
Bạn cần sửa j = j + 1 thành k = k + 1,
sarr(k, l) = arr(i, l)
và If j > 0 Then khongtrung3 = sarr thành If k > 0 Then khongtrung3 = sarr

Tuy nhiên, bạn vẫn bị vấn đề là mảng trả về sẽ dài hơn số dòng dữ liệu mà nó ghi

Bài này sửa hơi khó. Bởi vì nếu thêm một tham số để trả về số dòng ghi thì hàm hơi khó dùng.
Phải biết code gọi hàm mới sửa cho đúng được

Cách sửa dễ hơn là redim mảng mỗi lần cần ghi 1 dòng mới. Nhưng như vậy là loại code tệ, không hiệu quả.

Chú thích ngoài:
(tôi gọi là ngoài vì nó không liên quan đến lỗi bạn đang gặp, nhưng nó là một lỗi ngầm mà một ngày nào đó có thể gây ra dữ liệu sai)
dùng ghép chuỗi để tạo key như vậy không an toàn
"abc" & "def" sẽ ra giống "ab" & "cdef"
Nên chèn 1 delimiter giữa chúng, "," chẳng hạn

VetMini · 15/6/17

@befaint:
nếu muốn mảng thứ hai thì bạn có thể dùng lại arr, bởi vì đến đó nó hết cần giữ dữ liệu rồi.

befaint · 15/6/17

eke_rula đã viết:
Anh tạo ra một mảng nữa, đã hiểu vấn đề, cám ơn anh!!!

Trường hợp kết quả cần lấy là 1 cột thì có phương án là cho mảng kết quả (mangTam) ở dạng mảng 1 chiều.
Sau đó, ta chuyển mangTam về dạng mảng 2 chiều có 1 cột (mangKQ). Có các cách:
- mangKQ=Application.Transpose(mangTam)
Hoặc:
- Viết thêm một hàm để chuyển mảng 1 chiều thành mảng 2 chiều có 1 cột:

PHP:

Redim mangKQ(1 to ubound(mangTam)-lbound(mangTam)+1,0)
Dim m, i as long
For each m in mangTam
   i=i+1
   mangKQ(i,0)=m
next m

VetMini · 15/6/17

Nếu có delimiters ở giữa các dữ liệu thì thật ra khong cần phải chép vào mảng liền.
Sau khi đọc hết rồi thì đọc dọc theo keys của dic và tách ra từng dòng cũng được

Nếu vì lý do nào đó khong thể tách key (dữ liẹu nhiều hơn key) thì có thể ghi item là vị trí dòng của mảng, và chép lại sau.

ndu96081631 · 15/6/17

eke_rula đã viết:
Em có đoạn code này :

Cuối cũng thì bạn cũng cưới.. VợBa
Lần đầu tiên mà "chơi lớn" hen!

befaint · 15/6/17

ndu96081631 đã viết:
Cuối cũng thì bạn cũng cưới.. VợBa
Lần đầu tiên mà "chơi lớn" hen!

Lâu rồi anh ơi. Từ bài có ghi "... công thức, cột phụ hay VBA đều được..." đó anh.

VetMini · 15/6/17

ndu96081631 đã viết:
Cuối cũng thì bạn cũng cưới.. VợBa
Lần đầu tiên mà "chơi lớn" hen!

Tôi có nói rồi. Chơi Excel mà qua công thức mảng cũng như chơi xì ke, thể nào cũng nghiện hút. Hút cần một thời gian bắt buộc phải qua thứ nặng hơn, chích.

AutoReply · 15/6/17

ndu96081631 đã viết:
Cuối cũng thì bạn cũng cưới.. VợBa
Lần đầu tiên mà "chơi lớn" hen!

"lần đầu tiên" của bạn chủ thớt thật là mạnh mẽ, quả nhiên là anh hùng xuất thiếu niên. $-\\/.$ $-\\/.$
chả bù với mình mất 3 năm để biết sử dụng chức năng Record Macro, lại mất thêm 3 năm nữa để chạy được vòng lặp đầu tiên. +-+-+-+

VetMini · 15/6/17

AutoReply đã viết:
"lần đầu tiên" của bạn chủ thớt thật là mạnh mẽ, quả nhiên là anh hùng xuất thiếu niên. $-\\/.$ $-\\/.$
chả bù với mình mất 3 năm để biết sử dụng chức năng Record Macro, lại mất thêm 3 năm nữa để chạy được vòng lặp đầu tiên.

Mất mấy năm nữa mới chống lầy?

NguyenNgocThuHien · 15/6/17

eke_rula đã viết:
Em có đoạn code này :

Mã:

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!!!

Code trên dùng phép ghép chữ để kiểm tra sẽ không đảm bảo tính chính xác, tốc độ có khi bị ảnh hưởng, nếu ghép text thì nên ghép thêm vài ký tự đặc biệt chẳng hạn để tránh việc nhầm lẫn text=text & "<->" &arr(i,j)
Mà hình như trên GPE, việc lấy duy nhất có code rồi cơ mà.

eke_rula · 15/6/17

VetMini đã viết:
Dạng code này nhìn quen lắm. Quen ở chỗ đám i, j, k, l
Thường thường tác giả dùng k để đếm số dòng sử dụng. Code của bạn bị lẫn nó thành j.
Bạn cần sửa j = j + 1 thành k = k + 1,
sarr(k, l) = arr(i, l)
và If j > 0 Then khongtrung3 = sarr thành If k > 0 Then khongtrung3 = sarr

Tuy nhiên, bạn vẫn bị vấn đề là mảng trả về sẽ dài hơn số dòng dữ liệu mà nó ghi

Bài này sửa hơi khó. Bởi vì nếu thêm một tham số để trả về số dòng ghi thì hàm hơi khó dùng.
Phải biết code gọi hàm mới sửa cho đúng được

Cách sửa dễ hơn là redim mảng mỗi lần cần ghi 1 dòng mới. Nhưng như vậy là loại code tệ, không hiệu quả.

Chú thích ngoài:
(tôi gọi là ngoài vì nó không liên quan đến lỗi bạn đang gặp, nhưng nó là một lỗi ngầm mà một ngày nào đó có thể gây ra dữ liệu sai)
dùng ghép chuỗi để tạo key như vậy không an toàn
"abc" & "def" sẽ ra giống "ab" & "cdef"
Nên chèn 1 delimiter giữa chúng, "," chẳng hạn

Vâng, đúng là em bị nhầm chỗ đấy, nhìn code của anh @befaint viết lại em mới thấy, mà không hiểu sao nó vẫn đúng, không biết phải do nó kết thúc vòng lặp không nữa.
Không biết tính dùng offset để lấy luôn, mà không biết được không, chưa thử vì hàm excel thi offset không sài được.
Tại em mới tập viết đúng ra là phải dùng thêm kí tự chen vào giữa , hàm công thức em cũng thường làm vậy, làm nó ra kết quả là mừng quá rôi!!
Cám ơn anh!!

eke_rula · 15/6/17

NguyenNgocThuHien đã viết:
Code trên dùng phép ghép chữ để kiểm tra sẽ không đảm bảo tính chính xác, tốc độ có khi bị ảnh hưởng, nếu ghép text thì nên ghép thêm vài ký tự đặc biệt chẳng hạn để tránh việc nhầm lẫn text=text & "<->" &arr(i,j)
Mà hình như trên GPE, việc lấy duy nhất có code rồi cơ mà.

Dạ, đúng là không chính xác, em đang tập viết chị ạ, nên code nó mới chưa đúng

!!!

AutoReply · 15/6/17

VetMini đã viết:
Mất mấy năm nữa mới chống lầy?

Chừng nào diễn đàn GPE không bàn về Excel nữa .

HieuCD · 15/6/17

AutoReply đã viết:
"lần đầu tiên" của bạn chủ thớt thật là mạnh mẽ, quả nhiên là anh hùng xuất thiếu niên. $-\\/.$ $-\\/.$
chả bù với mình mất 3 năm để biết sử dụng chức năng Record Macro, lại mất thêm 3 năm nữa để chạy được vòng lặp đầu tiên.

Nhìn hình thấy còn quá trẻ, có lẽ chưa tới 19, vậy là biết viết code từ tuổi 13?
Bạn mất thêm bao nhiêu năm mới viết được các độc chiêu đáng nể của những người thích đùa?
Chúc bạn 1 tối vui /-*+/

eke_rula · 15/6/17

ndu96081631 đã viết:
Cuối cũng thì bạn cũng cưới.. VợBa
Lần đầu tiên mà "chơi lớn" hen!

Thấy đến lúc rồi anh,

!!!
Em coi bài của anh @kyo viết về scripting.dictionary và thấy có bài của anh , xem được 2 bài là 1 bài 1 cột và 2 cột, nhiều cột em cũng thấy nhưng chưa xem, chỉ dựa vào 2 bài kia viết thử thôi ạ!!!

dazkangel · 15/6/17

eke_rula đã viết:
Em có đoạn code này :

Mã:

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!!!

ngưỡng mộ mình gần 30 mà chưa hiểu gì

eke_rula · 15/6/17

befaint đã viết:
Trường hợp kết quả cần lấy là 1 cột thì có phương án là cho mảng kết quả (mangTam) ở dạng mảng 1 chiều.
Sau đó, ta chuyển mangTam về dạng mảng 2 chiều có 1 cột (mangKQ). Có các cách:
- mangKQ=Application.Transpose(mangTam)
Hoặc:
- Viết thêm một hàm để chuyển mảng 1 chiều thành mảng 2 chiều có 1 cột:

PHP:

Redim mangKQ(1 to ubound(mangTam)-lbound(mangTam)+1,0) Dim m, i as long For each m in mangTam i=i+1 mangKQ(i,0)=m next m

Em hiểu cái code này, nhưng để làm gì vậy anh, vì nếu theo code em gửi thì kết quả là mảng 2 chiều anh!!!

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

Thành viên tích cực

|||||||||||||

Thành viên tích cực

Ăn cùng góc phố

Ăn cùng góc phố

|||||||||||||

Ăn cùng góc phố

Huyền thoại GPE

|||||||||||||

Ăn cùng góc phố

Thành viên tiêu biểu

Ăn cùng góc phố

Cute Black Cat

Thành viên tích cực

Thành viên tích cực

Thành viên tiêu biểu

Chuyên gia GPE

Thành viên tích cực

<New Horizons>

Thành viên tích cực

Facebook

Group