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

Liên hệ QC
eke_rula

eke_rula

Thành viên tích cực
Tham gia
12/11/16
Bài viết
1,076
Được thích
1,245
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!!!
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
HieuCD đã viết:
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 /-*+//-*+//-*+/
Nhấp chuột vào đây để mở rộng...

Đúng là mấy cậu tre trẻ cứ thấy hình ngừoi đẹp là rộn lên, quên hết.
Hình đó là hình hồi ngừoi ta mới tập gõ bàn tính; 3 năm sau mới biết Excel, 3 năm nữa mới thử record macro...
Biết đến trình độ bi giờ là bao nhiêu cái 3 năm hôn?
 
Upvote 0
VetMini đã viết:
Đúng là mấy cậu tre trẻ cứ thấy hình ngừoi đẹp là rộn lên, quên hết.
Hình đó là hình hồi ngừoi ta mới tập gõ bàn tính; 3 năm sau mới biết Excel, 3 năm nữa mới thử record macro...
Biết đến trình độ bi giờ là bao nhiêu cái 3 năm hôn?
Nhấp chuột vào đây để mở rộng...
Anh HieuCD biết cô xinh đẹp đó là "thanh niên thích đùa" (từ khóa) mà anh.
 
Upvote 0
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
Nhấp chuột vào đây để mở rộng...

Mảng một chiều thì ghi và lấy luôn từ Dic để đổi qua mảng 2 chiều 1 cột, khỏi phải qua mảng tạm.
 
Upvote 0
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!!!
Nhấp chuột vào đây để mở rộng...
thử với code
Mã: 
Function khongtrung3(ByVal rng As Range)
Dim arr As Variant, Sarr As Variant, i As Long, j As Long, text As String, S
arr = rng.Value
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
          .Add text, ""
          k = k + 1
          .Add k, i
        End If
        text = ""
    Next i
    If .Count > 0 Then
        ReDim Sarr(1 To .Count / 2, 1 To UBound(arr, 2))
        For k = 1 To UBound(Sarr)
            i = .Item(k)
            For j = 1 To UBound(arr, 2)
                Sarr(k, j) = arr(i, j)
            Next j
        Next k
        khongtrung3 = Sarr
    End If
End With
End Function
 
Upvote 0
HieuCD đã viết:
thử với code
Mã: 
Function khongtrung3(ByVal rng As Range)
Dim arr As Variant, Sarr As Variant, i As Long, j As Long, text As String, S
arr = rng.Value
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
          .Add text, ""
          k = k + 1
          .Add k, i
        End If
        text = ""
    Next i
    If .Count > 0 Then
        ReDim Sarr(1 To .Count / 2, 1 To UBound(arr, 2))
        For k = 1 To UBound(Sarr)
            i = .Item(k)
            For j = 1 To UBound(arr, 2)
                Sarr(k, j) = arr(i, j)
            Next j
        Next k
        khongtrung3 = Sarr
    End If
End With
End Function
Nhấp chuột vào đây để mở rộng...
Cách này hay anh lấy thẳng từ dic ra luôn, đỡ hơn tạo một mảng, cám ơn anh!!!
Cho em hoi thêm cái tham số byval và Variant nghĩa là gì vậy anh!!!
 
Upvote 0
befaint đã viết:
Nhầm chỗ này rồi anh.
Nhấp chuột vào đây để mở rộng...
Dư lệnh: Len(text) > 0 cũng không ảnh hưởng lớn, chỉnh lại
If Not .exists(text) Then
eke_rula đã viết:
Cách này hay anh lấy thẳng từ dic ra luôn, đỡ hơn tạo một mảng, cám ơn anh!!!
Cho em hoi thêm cái tham số byval và Variant nghĩa là gì vậy anh!!!
Nhấp chuột vào đây để mở rộng...
Không khai báo cụ thể dạng biến như: "Dim Arr" thì mặc định là Variant, dạng "tổng quát" nhận giá trị dạng nào cũng được, theo thói quen có thể khai báo mảng Arr là: Dim Arr(), Dim Arr, Dim Arr as Variant
Nếu sau đó có redim Arr(...) thì các khai báo trên có kết quả giống nhau, còn nếu gán giá trị trực tiếp thì có thể khác nhau, Dim Arr() chỉ cho phép gán giá trị mảng (nhiều dòng hoặc (và) nhiều cột) , 2 khai báo sau thì giá trị nào cũng được
byval cũng không rỏ, hình như nó là biến riêng của Function, nên có thể đặt trùng tên với các sub và Function khác trong 1 modul, và các code không bị nhầm lẫn tên biến nầy, thấy các bạn dùng mình dùng theo
 
Upvote 0
HieuCD đã viết:
thử với code
Mã: 
Function khongtrung3(ByVal rng As Range)
Dim arr As Variant, Sarr As Variant, i As Long, j As Long, text As String, S
arr = rng.Value
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
          .Add text, ""
          k = k + 1
          .Add k, i     ' --- lưu ý, nếu k bị trùng với text là tiêu, nên dùng k & "|" & text
        End If
        text = ""
    Next i
    If .Count > 0 Then
        ReDim Sarr(1 To .Count / 2, 1 To UBound(arr, 2))
        For k = 1 To UBound(Sarr)
            i = .Item(k)
            For j = 1 To UBound(arr, 2)
                Sarr(k, j) = arr(i, j)
            Next j
        Next k
        khongtrung3 = Sarr
    End If
End With
End Function
Nhấp chuột vào đây để mở rộng...

Code của bạn là code theo kiểu Collection hoặc Arraylist, loại này chỉ có dữ liệu đơn độc
Dictionary là loại key đi đôi với dữ liệu - nó chính là cái item

Mã: 
    For i = 1 To UBound(arr)
        text = ""   ' --- nên dọn rác text trước khi dùng, an toàn hơn (code của bạn sau khi dùng mới dọn cho lượt kế tiếp)
        For j = 1 To UBound(arr, 2)
            text = text & "#" & arr(i, j)
        Next j
        If Len(text) > 0 And Not .exists(text) Then
          .Add text, i   '  --- đưa thẳng chỉ số dòng vào làm item
        End If
    Next i
    If .Count > 0 Then
        ReDim Sarr(1 To .Count, 1 To UBound(arr, 2))
' ----- đến đây, bạn có 2 cách đẻ lấy dữ liệu từ Dic
'        --- cách thứ nhất là dùng vồng lặp duyệt qua tùng key
        k = 0
        Dim ky as variant
        For each ky in .Keys
            k = k + 1
            i = .Item(ky)
            For j = 1 To UBound(arr, 2)
                Sarr(k, j) = arr(i, j)
            Next j
        Next ky
'        --- cách thứ hai là dùng vòng lặp duyệt thẳng từng item
        Dim itm as long
        For itm = 0 to .Count - 1
            i = .Items()(itm)   '  --- lưu ý đây là phương thức trả về 1 mảng, tức là ta lấy phần tử thứ itm của mảng Items
            For j = 1 To UBound(arr, 2)
                Sarr(itm+1, j) = arr(i, j)
            Next j
        Next itm
' ----- bình thường thì người ta dùng cách 1 bởi vì cần cả trị key lẫn item.
' ----- Nhưng riêng bài này, cái item đưa đến dòng dữ liệu có trị key luôn nên cách 2 nhanh hơn
        khongtrung3 = Sarr
    End If
 
Upvote 0
Upvote 0
HieuCD đã viết:
byval cũng không rỏ, hình như nó là biến riêng của Function, nên có thể đặt trùng tên với các sub và Function khác trong 1 modul, và các code không bị nhầm lẫn tên biến nầy, thấy các bạn dùng mình dùng theo
Nhấp chuột vào đây để mở rộng...

byVal có nghĩa là hàm tự tạo một biến riêng cho nó và chép lại trị (do đó có từ Val) của tham số. Vì là biến khác rồi cho nên nó có thể thay đổi mà khong ảnh hưởng tham

Trái với byVal là brRef hàm chỉ dùng cái tên đó để gọi (do đó có từ Ref) cái tham số mà nó nhận.

Function F1(byVal a)
Function F2(byRef a)
Cả 2 hàm trên đều có thể sử dụng một biến tên là a

gọi hàm
F1 x ' hàm gán trị của x cho biến a của nó. Bên trong hàm có thể thay đổi a mà khong ảnh hưởng x
F2 x ' hàm coi như x là biến tên a. Bên trong hàm a thay đổi thì x thay đổi theo

Đây là nói chuyện biến kiểu đơn giản. Các loại biến phức tạp như Object thì hơi khác chút.
 
Upvote 0
VetMini đã viết:
Code của bạn là code theo kiểu Collection hoặc Arraylist, loại này chỉ có dữ liệu đơn độc
Dictionary là loại key đi đôi với dữ liệu - nó chính là cái item

Mã: 
    For i = 1 To UBound(arr)
        text = ""   ' --- nên dọn rác text trước khi dùng, an toàn hơn (code của bạn sau khi dùng mới dọn cho lượt kế tiếp)
        For j = 1 To UBound(arr, 2)
            text = text & "#" & arr(i, j)
        Next j
        If Len(text) > 0 And Not .exists(text) Then
          .Add text, i   '  --- đưa thẳng chỉ số dòng vào làm item
        End If
    Next i
    If .Count > 0 Then
        ReDim Sarr(1 To .Count, 1 To UBound(arr, 2))
' ----- đến đây, bạn có 2 cách đẻ lấy dữ liệu từ Dic
'        --- cách thứ nhất là dùng vồng lặp duyệt qua tùng key
        k = 0
        Dim ky as variant
        For each ky in .Keys
            k = k + 1
            i = .Item(ky)
            For j = 1 To UBound(arr, 2)
                Sarr(k, j) = arr(i, j)
            Next j
        Next ky
'        --- cách thứ hai là dùng vòng lặp duyệt thẳng từng item
        Dim itm as long
        For itm = 0 to .Count - 1
            i = .Items()(itm)   '  --- lưu ý đây là phương thức trả về 1 mảng, tức là ta lấy phần tử thứ itm của mảng Items
            For j = 1 To UBound(arr, 2)
                Sarr(itm+1, j) = arr(i, j)
            Next j
        Next itm
' ----- bình thường thì người ta dùng cách 1 bởi vì cần cả trị key lẫn item.
' ----- Nhưng riêng bài này, cái item đưa đến dòng dữ liệu có trị key luôn nên cách 2 nhanh hơn
        khongtrung3 = Sarr
    End If
Nhấp chuột vào đây để mở rộng...
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!!!
 
Upvote 0
VetMini đã viết:
Code của bạn là code theo kiểu Collection hoặc Arraylist, loại này chỉ có dữ liệu đơn độc
Dictionary là loại key đi đôi với dữ liệu - nó chính là cái item

Mã: 
'        --- cách thứ hai là dùng vòng lặp duyệt thẳng từng item
        Dim itm as long
        For itm = 0 to .Count - 1
            i = .Items()(itm)   '  --- lưu ý đây là phương thức trả về 1 mảng, tức là ta lấy phần tử thứ itm của mảng Items
            For j = 1 To UBound(arr, 2)
                Sarr(itm+1, j) = arr(i, j)
            Next j
        Next itm
' ----- bình thường thì người ta dùng cách 1 bởi vì cần cả trị key lẫn item.
' ----- Nhưng riêng bài này, cái item đưa đến dòng dữ liệu có trị key luôn nên cách 2 nhanh hơn
        khongtrung3 = Sarr
    End If
Nhấp chuột vào đây để mở rộng...

chỗ này hơi lạ ( và không giống phong cách của ngài Bác sĩ Thú Y Nhỏ)
Dictionary có chức năng thêm vào bớt ra key ở bất cứ đâu , nhưng mảng thì không có chức năng này.
Theo suy đoán của tôi thì hàm .Items không phải 1 mảng cố định (Nếu thêm key vào Dictionary thì sửa mảng bằng cách nào ?)
Cái này không chắc, tôi đoán rằng Dictionary phải tính toán và tạo 1 mảng mới cho mỗi lần gọi hàm .Items
Như thế việc gọi .Items bên trong vòng lặp sẽ tốn nhiều năng lượng hơn là đặt ở ngoài.
Anh có có kinh nghiệm xin cho tôi biết rõ hơn về vấn đề này.
Cảm ơn.
 
Upvote 0
AutoReply đã viết:
chỗ này hơi lạ ( và không giống phong cách của ngài Bác sĩ Thú Y Nhỏ)
Dictionary có chức năng thêm vào bớt ra key ở bất cứ đâu , nhưng mảng thì không có chức năng này.
Theo suy đoán của tôi thì hàm .Items không phải 1 mảng cố định (Nếu thêm key vào Dictionary thì sửa mảng bằng cách nào ?)
Cái này không chắc, tôi đoán rằng Dictionary phải tính toán và tạo 1 mảng mới cho mỗi lần gọi hàm .Items
Như thế việc gọi .Items bên trong vòng lặp sẽ tốn nhiều năng lượng hơn là đặt ở ngoài.
Anh có có kinh nghiệm xin cho tôi biết rõ hơn về vấn đề này.
Cảm ơn.
Nhấp chuột vào đây để mở rộng...

Phong cách BS thì khong giống, nhưng đường lối thì luôn là con Anh Vũ.
Tôi đưa ra một kiểu duyệt dãy đơn giản thôi. Chứ nếu cái dãy ấy rất dài thì cách tốt nhất là cóp luôn nó ra một mảng rồi duyệt.

a = dic.Items
for i = 0 to dic.Count-1
debug.print a(i)
Next i
' hoặc
for each a in dic.Items ' for each chậm hơn for i= một tẹo
debug.print Cstr(a)
Next a

Theo tôi thì Items của Dictionary khong phải là mảng (array) mà là nhóm (collection). Tôi nghĩ MS dựng bên trong nó tương tự như vector của C++ hay Java (*). Chỉ nghĩ vậy thôi chứ khong màng tìm hiểu thêm bởi vì theo nguyen tắc HĐT, cái interface mới cần biết chứ cái implementation tác giả có thể thay đổi bất cứ lúc nào.

Tuy nhiên, theo tinh thần Script, VBScript là mọt ngôn ngữ tạp, nó có các dụng cụ chuyên chuyển các loại dữ liệu từ kiểu này sang kiểu khác dựa vào tính chất tương hợp (tôi nghĩ trình độ bạn phải qua JavaScript rồi và hiểu tính chất chuyển dữ liệu này rất rõ). Như code trên tôi cho thấy cái collection có thể dễ dàng copy ra thành mảng thuần tuý (cũng như các bạn có thể copy range ra mảng vậy)

Vì tôi đoán VBScript dùng vector cho Keys và Items của nó cho nên tôi tin việc dùng phương thức Keys() hay Items() và lấy phần tử theo chỉ số tốn năng lượng chỉ hơn trên mảng bình thường 1 chút xíu - khong đáng kể với vài ngàn phần tử.

(*) vector của C++ và Java là loại class dùng để dựng mảng có thể co dãn được
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

GPE-Trợ Lý
  • Dán lên cao
Đại Tiệc Sinh Nhật GPE thứ 18 - TeamBuilding Đà Nẵng 2N1D [06-07/07/2024]
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
7
Đọc
603
moneymong.pt
moneymong.pt
thaipv
#LabX - Addin khóa và mở khóa mã nguồn vbaProject
    • Thích
3 4 5
Trả lời
84
Đọc
20K
lockonz
lockonz
D
  • Question
Nhờ GPE viết code nhập dữ liệu từ 2 textbox vào listbox
    • Cười
Trả lời
2
Đọc
67
Hoàng Trọng Nghĩa
Hoàng Trọng Nghĩa
D
  • Question
Xin giải pháp nhập dữ liệu vào ô trống hàng loạt
Trả lời
6
Đọc
232
Decepticon
D
hung2412
  • Question
Xin chỉ cách bỏ qua dòng Code ở dưới và đi thẳng đến dòng Code được chỉ định
Trả lời
14
Đọc
339
ptm0412
ptm0412
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom