Sort mảng!!

Liên hệ QC

Mr Okebab

Ngon Ngất Ngây
Thành viên đã mất
Tham gia
6/8/06
Bài viết
3,260
Được thích
3,787
Mình có một mảng Temp gồm 1 cột chứa 50 phần tử. (mảng tạm trong VBA)

Vậy có cách nào Sort nó như là lọc 1 range không nhỉ ???
Các bác giải đáp giúp nhé.

Thanks.

Thân!
 
SoiBien đã viết:
Bác Bắp xài cái code quicksort này nhé.
Mã:
[COLOR=green]' Use Quicksort to sort a list.[/COLOR]
[COLOR=green]'[/COLOR]
' This code is from the book "Ready-to-Run
[COLOR=green]' Visual Basic Algorithms" by Rod Stephens.[/COLOR]
[COLOR=green]' [URL="http://www.vb-helper.com/vba.htm"]http://www.vb-helper.com/vba.htm[/URL][/COLOR]
[COLOR=darkblue]Sub[/COLOR] Quicksort(list(), [COLOR=darkblue]ByVal[/COLOR] min [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR], [COLOR=darkblue]ByVal[/COLOR] max [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR])
[COLOR=darkblue]Dim[/COLOR] mid_value
[COLOR=darkblue]Dim[/COLOR] hi [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
[COLOR=darkblue]Dim[/COLOR] lo [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
[COLOR=darkblue]Dim[/COLOR] i [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    [COLOR=green]' If there is 0 or 1 item in the list,[/COLOR]
    [COLOR=green]' this sublist is sorted.[/COLOR]
    [COLOR=darkblue]If[/COLOR] min >= max [COLOR=darkblue]Then[/COLOR] [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
    [COLOR=green]' Pick a dividing value.[/COLOR]
    i = Int((max - min + 1) * Rnd + min)
    mid_value = list(i)
    [COLOR=green]' Swap the dividing value to the front.[/COLOR]
    list(i) = list(min)
    lo = min
    hi = max
    [COLOR=darkblue]Do[/COLOR]
        [COLOR=green]' Look down from hi for a value < mid_value.[/COLOR]
        [COLOR=darkblue]Do[/COLOR] [COLOR=darkblue]While[/COLOR] list(hi) >= mid_value
            hi = hi - 1
            [COLOR=darkblue]If[/COLOR] hi <= lo [COLOR=darkblue]Then[/COLOR] [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Do[/COLOR]
        [COLOR=darkblue]Loop[/COLOR]
        [COLOR=darkblue]If[/COLOR] hi <= lo [COLOR=darkblue]Then[/COLOR]
            list(lo) = mid_value
            [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Do[/COLOR]
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
        [COLOR=green]' Swap the lo and hi values.[/COLOR]
        list(lo) = list(hi)
        [COLOR=green]' Look up from lo for a value >= mid_value.[/COLOR]
        lo = lo + 1
        [COLOR=darkblue]Do[/COLOR] [COLOR=darkblue]While[/COLOR] list(lo) < mid_value
            lo = lo + 1
            [COLOR=darkblue]If[/COLOR] lo >= hi [COLOR=darkblue]Then[/COLOR] [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Do[/COLOR]
        [COLOR=darkblue]Loop[/COLOR]
        [COLOR=darkblue]If[/COLOR] lo >= hi [COLOR=darkblue]Then[/COLOR]
            lo = hi
            list(hi) = mid_value
            [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Do[/COLOR]
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
        [COLOR=green]' Swap the lo and hi values.[/COLOR]
        list(hi) = list(lo)
    [COLOR=darkblue]Loop[/COLOR]
    [COLOR=green]' Sort the two sublists.[/COLOR]
    Quicksort list, min, lo - 1
    Quicksort list, lo + 1, max
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
Bác sắp xếp MangTemp thì dùng như sau
Mã:
Quicksort MangTemp(), [COLOR=darkblue]LBound[/COLOR](MangTemp), [COLOR=darkblue]UBound[/COLOR](MangTemp)
Cho em ké một ly "Bàu đá" nhé. :))

Cảm ơn cậu nhưng . . . vẫn chưa được.

PHP:
Function DanhSachMSX2(MangDL As Range)
    Application.ScreenUpdating = False
    Dim i As Long, i2, i1 As Long, m As Integer, Tim As Boolean, Ma As Range
    Dim MangTemp(1 To 1000, 0) As Variant
    Dim Mang(1 To 1000, 0)
    If MangDL.Rows.Count = 0 Then Exit Function
    For Each Ma In MangDL
        i = i + 1
        If i = 1 Then
            m = m + 1
            MangTemp(m, 0) = Ma.Value
        Else
            For i1 = 1 To m
                If UCase(MangTemp(i1, 0)) = UCase(Ma) Then
                    Tim = True
                    Exit For
                End If
            Next i1
            If Tim = False Then
                m = m + 1
                MangTemp(m, 0) = Ma.Value
            End If
        End If
        Tim = False
    Next
    Quicksort MangTemp(), LBound(MangTemp), UBound(MangTemp)
    DanhSachMSX2 = MangTemp
    Set Ma = Nothing
    Application.ScreenUpdating = True
End Function

Tớ thay vào thì . . bị lỗi luôn:=\+:=\+:=\+

Cậu thay luôn giùm tớ xem.
Thanks!!

Thân!
 
Upvote 0
Hix, MangTemp cua bác Bap la 2 chieu (chieu kia có 0 phần tử, để làm gì vậy nhỉ???) .
Rồi, để sửa lại cái QuickSort một tí thôi.
 
Upvote 0
SoiBien đã viết:
Hix, MangTemp cua bác Bap la 2 chieu (chieu kia có 0 phần tử, để làm gì vậy nhỉ???) .
Rồi, để sửa lại cái QuickSort một tí thôi.

Tớ đang học về mảng. Cho 1 chiều như bác SA không chịu. Đành cho 2 chiều.--=0

Bác đổi lại thành 1 chiều giùm được không

Cảm ơn nhiều!!

Thân!
 
Upvote 0
Mã:
[color=darkblue]Function[/color] DanhSachMSX2(MangDL [color=darkblue]As[/color] Range)
    Application.ScreenUpdating = [color=darkblue]False[/color]
    [color=darkblue]Dim[/color] i [color=darkblue]As[/color] [color=darkblue]Long[/color], i2, i1 [color=darkblue]As[/color] [color=darkblue]Long[/color], m [color=darkblue]As[/color] [color=darkblue]Integer[/color], Tim [color=darkblue]As[/color] [color=darkblue]Boolean[/color], Ma [color=darkblue]As[/color] Range
    [color=darkblue]Dim[/color] MangTemp(1 [color=darkblue]To[/color] 1000, 0) [color=darkblue]As[/color] [color=darkblue]Variant[/color]
    [color=darkblue]Dim[/color] Mang(1 [color=darkblue]To[/color] 1000, 0)
    [color=darkblue]If[/color] MangDL.Rows.Count = 0 [color=darkblue]Then[/color] [color=darkblue]Exit[/color] [color=darkblue]Function[/color]
    [color=darkblue]For[/color] [color=darkblue]Each[/color] Ma [color=darkblue]In[/color] MangDL
        i = i + 1
        [color=darkblue]If[/color] i = 1 [color=darkblue]Then[/color]
            m = m + 1
            MangTemp(m, 0) = Ma.Value
        [color=darkblue]Else[/color]
            [color=darkblue]For[/color] i1 = 1 [color=darkblue]To[/color] m
                [color=darkblue]If[/color] UCase(MangTemp(i1, 0)) = UCase(Ma) [color=darkblue]Then[/color]
                    Tim = [color=darkblue]True[/color]
                    [color=darkblue]Exit[/color] [color=darkblue]For[/color]
                [color=darkblue]End[/color] [color=darkblue]If[/color]
            [color=darkblue]Next[/color] i1
            [color=darkblue]If[/color] Tim = [color=darkblue]False[/color] [color=darkblue]Then[/color]
                m = m + 1
                MangTemp(m, 0) = Ma.Value
            [color=darkblue]End[/color] [color=darkblue]If[/color]
        [color=darkblue]End[/color] [color=darkblue]If[/color]
        Tim = [color=darkblue]False[/color]
    [color=darkblue]Next[/color]
    Quicksort MangTemp, 1, m
    DanhSachMSX2 = MangTemp
    [color=darkblue]Set[/color] Ma = [color=darkblue]Nothing[/color]
    Application.ScreenUpdating = [color=darkblue]True[/color]
[color=darkblue]End[/color] [color=darkblue]Function[/color]
[color=green]' Use Quicksort to sort a list of strings.[/color]
[color=green]'[/color]
' This code is from the book "Ready-to-Run
[color=green]' Visual Basic Algorithms" by Rod Stephens.[/color]
[color=green]' [URL="http://www.vb-helper.com/vba.htm"]http://www.vb-helper.com/vba.htm[/URL][/color]
[color=darkblue]Sub[/color] Quicksort(list, [color=darkblue]ByVal[/color] min [color=darkblue]As[/color] [color=darkblue]Long[/color], [color=darkblue]ByVal[/color] max [color=darkblue]As[/color] [color=darkblue]Long[/color])
[color=darkblue]Dim[/color] mid_value
[color=darkblue]Dim[/color] hi [color=darkblue]As[/color] [color=darkblue]Long[/color]
[color=darkblue]Dim[/color] lo [color=darkblue]As[/color] [color=darkblue]Long[/color]
[color=darkblue]Dim[/color] i [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=green]' If there is 0 or 1 item in the list,[/color]
    [color=green]' this sublist is sorted.[/color]
    [color=darkblue]If[/color] min >= max [color=darkblue]Then[/color] [color=darkblue]Exit[/color] [color=darkblue]Sub[/color]
    [color=green]' Pick a dividing value.[/color]
    i = Int((max - min + 1) * Rnd + min)
    mid_value = list(i, 0)
    [color=green]' Swap the dividing value to the front.[/color]
    list(i, 0) = list(min, 0)
    lo = min
    hi = max
    [color=darkblue]Do[/color]
        [color=green]' Look down from hi for a value < mid_value.[/color]
        [color=darkblue]Do[/color] [color=darkblue]While[/color] list(hi, 0) >= mid_value
            hi = hi - 1
            [color=darkblue]If[/color] hi <= lo [color=darkblue]Then[/color] [color=darkblue]Exit[/color] [color=darkblue]Do[/color]
        [color=darkblue]Loop[/color]
        [color=darkblue]If[/color] hi <= lo [color=darkblue]Then[/color]
            list(lo, 0) = mid_value
            [color=darkblue]Exit[/color] [color=darkblue]Do[/color]
        [color=darkblue]End[/color] [color=darkblue]If[/color]
        [color=green]' Swap the lo and hi values.[/color]
        list(lo, 0) = list(hi, 0)
        [color=green]' Look up from lo for a value >= mid_value.[/color]
        lo = lo + 1
        [color=darkblue]Do[/color] [color=darkblue]While[/color] list(lo, 0) < mid_value
            lo = lo + 1
            [color=darkblue]If[/color] lo >= hi [color=darkblue]Then[/color] [color=darkblue]Exit[/color] [color=darkblue]Do[/color]
        [color=darkblue]Loop[/color]
        [color=darkblue]If[/color] lo >= hi [color=darkblue]Then[/color]
            lo = hi
            list(hi, 0) = mid_value
            [color=darkblue]Exit[/color] [color=darkblue]Do[/color]
        [color=darkblue]End[/color] [color=darkblue]If[/color]
        [color=green]' Swap the lo and hi values.[/color]
        list(hi, 0) = list(lo, 0)
    [color=darkblue]Loop[/color]
    [color=green]' Sort the two sublists.[/color]
    Quicksort list, min, lo - 1
    Quicksort list, lo + 1, max
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
Sub thusort()

Bác thử nhé. vì số phần tử không cố định nên bác khai báo tới 1000 phần tử, dùng Ubound thì mình phải chọn tới 1000 ô luôn, vì khi sắp xếp tăng dần, các ô trống nó coi là 0, mà 0 < characters, đổi lại, khi gọi quicksort, thì mình chỉ cho nó sort từ lbound --> m.
 
Upvote 0
SA_DQ đã viết:
Mã:
Option Explicit:            Option Base 1 [B]
Function SortMatrix(Rng As Range, Optional Dess As Boolean)[/B]
  Dim Mang, temp, iJ As Integer, iZ As Integer
  Mang = Rng
  SortMatrix = Rng.Rows.Count
  ReDim MDLieu(SortMatrix, 1)
1 '[COLOR=Blue]. Sap Xep Danh Sach[/COLOR]
  For iZ = 1 To SortMatrix
  For iJ = 1 To SortMatrix - 1
    temp = Mang(iJ, 1)
    If temp > Mang(iJ + 1, 1) Then
        Mang(iJ, 1) = Mang(iJ + 1, 1)
        Mang(iJ + 1, 1) = temp
    End If
  Next iJ, iZ
2 '[COLOR=blue]. Lap Danh Sach Duy Nhat[/COLOR]
  iZ = 0:           temp = ""
  For iJ = 1 To SortMatrix
    If temp <> Mang(iJ, 1) Then
        iZ = 1 + iZ:        temp = Mang(iJ, 1)
        MDLieu(iZ, 1) = temp
    End If
  Next iJ
  For iJ = iZ + 1 To SortMatrix
    MDLieu(iJ, 1) = ""
  Next iJ
  
  SortMatrix = MDLieu [B]
  
End Function[/B]
)(&&@@

Đã thử từ danh sách 156 trùng lắp tên tỉnh, Hàm trả vể danh sách 72 tỉnh thành được xếp theo chiều tăng dần;
VD ta có danh sách 153 tên tỉnh thành tại cột A, từ A3 đến A156;
Ta quét chọn các ô tại cột E từ E3 đến E75;
Nhập vô thanh công thức: =SortMatrix ("A3:A156") & kết thúc = tổ hợp 3 fím sẽ nhận được KQ từ hàm!

Vâng, hàm của bác thật là ngắn. Qủa thật tư duy giải thuật của bác em không bằng được (Vô học - Không được học - nên tệ thế bác ạ--=0--=0)
Tuy nhiên cần sửa lại để không phân biệt chữ hoa và chữ thường. Của em chỉ có 71 bộ phận thôi.
(Sắp xếp của bác là chữ HOA trước, thường sau)
Chính vì thế có 2 bộ phận là Văn phòngVăn Phòng
Bác cho em hỏi : Hàm này thực hiện 2 công đoạn : Lọc ra DS Duy nhấtSắp xếp.
Vậy thì làm cái nào trước thì nhanh hơn ??
Thân!
 
Upvote 0
SoiBien đã viết:
Bác thử nhé. vì số phần tử không cố định nên bác khai báo tới 1000 phần tử, dùng Ubound thì mình phải chọn tới 1000 ô luôn, vì khi sắp xếp tăng dần, các ô trống nó coi là 0, mà 0 < characters, đổi lại, khi gọi quicksort, thì mình chỉ cho nó sort từ lbound --> m.

Rất tốt, cảm ơn cậu nhiều.

Tuy nhiên cái QuickSort của cậu vẫn phân biệt chữ thường và hoa.

Có cách nào để nó không phân biệt không ??

Thân!
 
Upvote 0
Mr Okebab đã viết:
Tuy nhiên cái QuickSort của cậu vẫn phân biệt chữ thường và hoa.

Có cách nào để nó không phân biệt không ??

Mã:
[color=green]' This code is from the book "Ready-to-Run[/color]
[color=green]' Visual Basic Algorithms" by Rod Stephens.[/color]
[color=green]' [URL="http://www.vb-helper.com/vba.htm"]http://www.vb-helper.com/vba.htm[/URL][/color]
[color=darkblue]Sub[/color] Quicksort(list, [color=darkblue]ByVal[/color] min [color=darkblue]As[/color] [color=darkblue]Long[/color], [color=darkblue]ByVal[/color] max [color=darkblue]As[/color] [color=darkblue]Long[/color])
[color=darkblue]Dim[/color] mid_value
[color=darkblue]Dim[/color] hi [color=darkblue]As[/color] [color=darkblue]Long[/color]
[color=darkblue]Dim[/color] lo [color=darkblue]As[/color] [color=darkblue]Long[/color]
[color=darkblue]Dim[/color] i [color=darkblue]As[/color] [color=darkblue]Long[/color]
    [color=green]' If there is 0 or 1 item in the list,[/color]
    [color=green]' this sublist is sorted.[/color]
    [color=darkblue]If[/color] min >= max [color=darkblue]Then[/color] [color=darkblue]Exit[/color] [color=darkblue]Sub[/color]
    [color=green]' Pick a dividing value.[/color]
    i = Int((max - min + 1) * Rnd + min)
    mid_value = list(i, 0)
    [color=green]' Swap the dividing value to the front.[/color]
    list(i, 0) = list(min, 0)
    lo = min
    hi = max
    [color=darkblue]Do[/color]
        [color=green]' Look down from hi for a value < mid_value.[/color]
        [color=darkblue]Do[/color] [color=darkblue]While[/color] UCase(list(hi, 0)) >= UCase(mid_value)
            hi = hi - 1
            [color=darkblue]If[/color] hi <= lo [color=darkblue]Then[/color] [color=darkblue]Exit[/color] [color=darkblue]Do[/color]
        [color=darkblue]Loop[/color]
        [color=darkblue]If[/color] hi <= lo [color=darkblue]Then[/color]
            list(lo, 0) = mid_value
            [color=darkblue]Exit[/color] [color=darkblue]Do[/color]
        [color=darkblue]End[/color] [color=darkblue]If[/color]
        [color=green]' Swap the lo and hi values.[/color]
        list(lo, 0) = list(hi, 0)
        [color=green]' Look up from lo for a value >= mid_value.[/color]
        lo = lo + 1
        [color=darkblue]Do[/color] [color=darkblue]While[/color] UCase(list(lo, 0)) < UCase(mid_value)
            lo = lo + 1
            [color=darkblue]If[/color] lo >= hi [color=darkblue]Then[/color] [color=darkblue]Exit[/color] [color=darkblue]Do[/color]
        [color=darkblue]Loop[/color]
        [color=darkblue]If[/color] lo >= hi [color=darkblue]Then[/color]
            lo = hi
            list(hi, 0) = mid_value
            [color=darkblue]Exit[/color] [color=darkblue]Do[/color]
        [color=darkblue]End[/color] [color=darkblue]If[/color]
        [color=green]' Swap the lo and hi values.[/color]
        list(hi, 0) = list(lo, 0)
    [color=darkblue]Loop[/color]
    [color=green]' Sort the two sublists.[/color]
    Quicksort list, min, lo - 1
    Quicksort list, lo + 1, max
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
Sub thusort()

Mình nghĩ chắc cũng bình thường như vầy thôi.
 
Upvote 0
Mr Okebab đã viết:
Vâng, hàm của bác thật là ngắn. Qủa thật tư duy giải thuật của bác em không bằng được (Vô học - Không được học - nên tệ thế bác ạ--=0--=0)
Mình cũng tự học mà, có bài bản zì lắm đâu!

Tuy nhiên cần sửa lại để không phân biệt chữ hoa và chữ thường. Của em chỉ có 71 bộ phận thôi.
(Sắp xếp của bác là chữ HOA trước, thường sau)
Chính vì thế có 2 bộ phận là Văn phòngVăn Phòng
Như vậy thì trước mỗi lần so sánh ta đưa hết thành chữ hoa hết, zây là chị sẽ như em thôi! Hàm Ucase() í;
(/í dụ
Mã:
 For iZ = 1 To SortMatrix
  For iJ = 1 To SortMatrix - 1
    temp = Mang(iJ, 1)
    If [B]Ucase[/B](temp) > [B]Ucase[/B]( Mang(iJ + 1, 1)) Then
        Mang(iJ, 1) = Mang(iJ + 1, 1)
        Mang(iJ + 1, 1) = temp
    End If
  Next iJ, iZ
Bác cho em hỏi : Hàm này thực hiện 2 công đoạn : Lọc ra DS Duy nhấtSắp xếp. Vậy thì làm cái nào trước thì nhanh hơn ??
Thân!
Bắp thấy dòng lệnh
Mã:
 If Temp >  Mang(iJ + 1,1)
chứ, mình mới nghỉ thôi, đợi sau chuyến đi mình sẽ thử về tốc độ theo iêu cầu của Bắp!
/)/hưng phải có Bàu đá mới chuyển giao (nếu Bắp chưa thử & chờ)
Mình thấy rằng công đoạn xếp dài hơn (theo cảm tính) đã vậy thì xếp DS ít sẽ lợi hơn!

Lợi thì có lợi, nhưng nhông không còn!
 
Upvote 0
SoiBien đã viết:
Mình nghĩ chắc cũng bình thường như vầy thôi.

Vũ Ngọc giới thiệu không sai tí nào.
Quả tiếng lành đồn xa!!--=0

Giờ tớ mới biết cái vụ Sub mà có đối số !!!+-+-+-+

Còn cái vụ nhiều chiều nữa, sửa lại cho thành 1 chiều được không ??
Mình sửa thành 1 chiều nhưng lại phải dùng hàm Transpose convert lại. Thế mới chán!! (từ hàng thành cột í mà)


Thân!

P/S : To Sa Tiên Sinh!! Bàu Đá thì bác có đầy rồi, cần gì thằng em này mang Bàu Đá "dởm" đến để "múa rìu qua mắt thợ". Vải thưa sao che được mắt thánh, phải không bác!!.
Chẳng qua là "Rượu ngon không có bạn hiền. . . không . . . không . . . không . . ."--=0
Hẹn ngày gặp bác!!
 
Upvote 0
Mr Okebab đã viết:
Còn cái vụ nhiều chiều nữa, sửa lại cho thành 1 chiều được không ??
Mình sửa thành 1 chiều nhưng lại phải dùng hàm Transpose convert lại. Thế mới chán!! (từ hàng thành cột í mà)

vụ này đang nghiên cứu, chưa có làm UDF trả về mảng, hì hì!!!
 
Upvote 0
Mr Okebab đã viết:
Còn cái vụ nhiều chiều nữa, sửa lại cho thành 1 chiều được không ??
Mình sửa thành 1 chiều nhưng lại phải dùng hàm Transpose convert lại. Thế mới chán!! (từ hàng thành cột í mà)

Có cần viết UDF trong trường hợp này không? Cái code sort rồi loại các dữ liệu duy nhất thì nên viết qua dạng sub thì hay hơn là UDF. UDF làm chậm máy.

Còn nếu OKebab muốn tìm hiểu vế cách chuyển đổi array nhiều chiều qua 1 chiều và ngược lại thì tham khảo link sau.


Mến
 
Upvote 0
digita đã viết:
Có cần viết UDF trong trường hợp này không? Cái code sort rồi loại các dữ liệu duy nhất thì nên viết qua dạng sub thì hay hơn là UDF. UDF làm chậm máy.

Mến

Vâng, cảm ơn bác nhiều về cái Link!!!

Còn sự cần thiết ??? Với em thì em . . .chẳng để làm gì cả !!!??
Chẳng qua là thử xem nó thế nào ??? Biết đâu có người cần ???
Cũng là một dịp nâng cao trình độ thôi bác ạ

Thân!
 
Upvote 0
Lọc danh sách duy nhất - trả về 3 loại danh sách

Mình cũng mới làm hàm UDF mảng, Hàm này trả về 3 loại danh sách tùy thuộc vào đối số Option kieuloc
  • Kieuloc = 2 : Danh sách trả về là các phần tử chỉ xuất hiện một lần
  • Kieuloc = 1 : Danh sách trả về là các phần tử xuất hiện > 1 lần
  • Kieuloc = 0 : Danh sách trả về bao gồm 2 kiểu trên
Mã:
[color=darkblue]Function[/color] LocDSduynhat(Danhsach [color=darkblue]As[/color] Range, [color=darkblue]Optional[/color] kieuloc [color=darkblue]As[/color] [color=darkblue]Byte[/color]) [color=darkblue]As[/color] [color=darkblue]Variant[/color]
    [color=darkblue]Dim[/color] Cacphantu() [color=darkblue]As[/color] [color=darkblue]Variant[/color], Sophantu() [color=darkblue]As[/color] [color=darkblue]Integer[/color]
    [color=darkblue]Dim[/color] DanhsachDuyNhat() [color=darkblue]As[/color] [color=darkblue]Variant[/color]
    [color=darkblue]Dim[/color] TongSophantu, i [color=darkblue]As[/color] [color=darkblue]Integer[/color]
    [color=darkblue]Dim[/color] Cell [color=darkblue]As[/color] Range
    [color=darkblue]Dim[/color] Found [color=darkblue]As[/color] [color=darkblue]Boolean[/color]
    TongSophantu = 0
    [color=darkblue]For[/color] [color=darkblue]Each[/color] Cell [color=darkblue]In[/color] Danhsach
        Found = [color=darkblue]False[/color]
        [color=darkblue]If[/color] TongSophantu = 0 [color=darkblue]Then[/color]
            TongSophantu = TongSophantu + 1
            Found = [color=darkblue]True[/color]
            [color=darkblue]ReDim[/color] [color=darkblue]Preserve[/color] Cacphantu(TongSophantu)
            [color=darkblue]ReDim[/color] [color=darkblue]Preserve[/color] Sophantu(TongSophantu)
            Cacphantu(1) = Cell.Value
            Sophantu(1) = 1
        [color=darkblue]End[/color] [color=darkblue]If[/color]
        i = 1
        [color=darkblue]While[/color] i <= TongSophantu And [color=darkblue]Not[/color] Found
            [color=darkblue]If[/color] Cacphantu(i) = Cell.Value [color=darkblue]Then[/color]
                Found = [color=darkblue]True[/color]
                Sophantu(i) = Sophantu(i) + 1
            [color=darkblue]End[/color] [color=darkblue]If[/color]
            i = i + 1
        [color=darkblue]Wend[/color]
        [color=darkblue]If[/color] [color=darkblue]Not[/color] Found [color=darkblue]Then[/color]
            TongSophantu = TongSophantu + 1
            Found = [color=darkblue]True[/color]
            [color=darkblue]ReDim[/color] [color=darkblue]Preserve[/color] Cacphantu([color=darkblue]To[/color]ngSophantu)
            [color=darkblue]ReDim[/color] [color=darkblue]Preserve[/color] Sophantu([color=darkblue]To[/color]ngSophantu)
            Cacphantu(i) = Cell.Value
            Sophantu(i) = 1
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]Next[/color] Cell
    [color=darkblue]Dim[/color] j, SwapInt [color=darkblue]As[/color] [color=darkblue]Integer[/color]
    [color=darkblue]Dim[/color] SwapVal [color=darkblue]As[/color] [color=darkblue]Variant[/color]
    [color=darkblue]For[/color] i = 1 [color=darkblue]To[/color] [color=darkblue]To[/color]ngSophantu - 1
        [color=darkblue]For[/color] j = i + 1 To TongSophantu
            [color=darkblue]If[/color] Cacphantu(i) > Cacphantu(j) [color=darkblue]Then[/color]
                SwapVal = Cacphantu(j)
                Cacphantu(j) = Cacphantu(i)
                Cacphantu(i) = SwapVal
                SwapInt = Sophantu(j)
                Sophantu(j) = Sophantu(i)
                Sophantu(i) = SwapInt
            [color=darkblue]End[/color] [color=darkblue]If[/color]
        [color=darkblue]Next[/color] j
    [color=darkblue]Next[/color] i
    [color=darkblue]Dim[/color] sophantutrave [color=darkblue]As[/color] [color=darkblue]Integer[/color]
    sophantutrave = 0
    [color=darkblue]Select[/color] [color=darkblue]Case[/color] kieuloc
    [color=darkblue]Case[/color] 2
        [color=darkblue]For[/color] i = 1 [color=darkblue]To[/color] TongSophantu
            [color=darkblue]If[/color] Sophantu(i) > 1 [color=darkblue]Then[/color]
                [color=darkblue]ReDim[/color] [color=darkblue]Preserve[/color] DanhsachDuyNhat(sophantutrave)
                DanhsachDuyNhat(sophantutrave) = Cacphantu(i)
                sophantutrave = sophantutrave + 1
            [color=darkblue]End[/color] [color=darkblue]If[/color]
        [color=darkblue]Next[/color] i
    [color=darkblue]Case[/color] 1
        [color=darkblue]For[/color] i = 1 To TongSophantu
            [color=darkblue]If[/color] Sophantu(i) = 1 [color=darkblue]Then[/color]
                [color=darkblue]ReDim[/color] [color=darkblue]Preserve[/color] DanhsachDuyNhat(sophantutrave)
                DanhsachDuyNhat(sophantutrave) = Cacphantu(i)
                sophantutrave = sophantutrave + 1
            [color=darkblue]End[/color] [color=darkblue]If[/color]
        [color=darkblue]Next[/color] i
    [color=darkblue]Case[/color] 0
        [color=darkblue]ReDim[/color] DanhsachDuyNhat(TongSophantu - 1)
        Debug.Print TongSophantu
        [color=darkblue]For[/color] i = 1 To TongSophantu
            DanhsachDuyNhat(i - 1) = Cacphantu(i)
        [color=darkblue]Next[/color] i
    [color=darkblue]End[/color] [color=darkblue]Select[/color]
    LocDSduynhat = DanhsachDuyNhat
    [color=darkblue]If[/color] Danhsach.Rows.Count >= Danhsach.Columns.Count [color=darkblue]Then[/color]
        LocDSduynhat = WorksheetFunction.Transpose(LocDSduynhat)
    [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]Set[/color] Cell = [color=darkblue]Nothing[/color]
[color=darkblue]End[/color] [color=darkblue]Function[/color]

Đây là file ví dụ.
 

File đính kèm

Upvote 0
Web KT

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

Back
Top Bottom