Sort mảng!! (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
Mr Okebab

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,790
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!
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Vụ này bác SoiBien chắc rành đây.
Chịu khó ra tay nhé SoiBien thân mến !
 
Upvote 0
Bắp thử 26 kí tự hay 26 kí số với củ chuối sau xem sao:

Mã: 
Option Explicit
[b]
Sub SortMatrit() [/b]
  Dim Mang, temp, iJ As Integer, iZ As Integer
  
  Mang = Range("A2:A15")
  Range("B2:B20").ClearContents
  For iZ = 1 To 19
    
  For iJ = 1 To 15 - 2
    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
  
  For iJ = 1 To 15 - 1
    Cells(iJ + 1, 2) = Mang(iJ, 1)
  Next iJ [b]
End Sub [/b]
 
Upvote 0
chibi đã viết:
Tôi không hiểu.
Nhấp chuột vào đây để mở rộng...

Bác có một vùng từ A1:A10 chứa tên người rất lộn xộn. Bác muốn sắp xếp thì bác sẽ dùng công cụ Sort của Excel.
Bây giờ , không phải là một vùng trên excel nữa mà là một mảng tạm trong VBA. Vậy sắp xếp thế nào đây ???

To bác SA : Để em nghiên cứu.

Thân!
 
Upvote 0
Anh Sa đưa ra code ví dụ sắp xếp dữ liệu từ dưới lên trên. Biến số iZ không cần trong code này. Cho tôi chỉnh code của anh như sau:

Option Explicit
Sub SortMatrix()
Dim Mang, temp, iJ, Lrow As Integer
Lrow = Range("A1").End(xlDown).Row
Mang = Range("A1:A" & Lrow)
Range("B1:B" & Lrow).ClearContents

For iJ = 1 To Lrow - 2
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

For iJ = 1 To Lrow
Cells(iJ, 2) = Mang(iJ, 1)
Next iJ
End Sub
Nhấp chuột vào đây để mở rộng...

Vậy nếu mình muốn sort theo chiều ngược lại thì làm sao? Các bạn tham khảo thêm nha.

Mến
 
Upvote 0
Digita chưa thử, phải không?

Biến số iZ không cần trong code này.
Nhấp chuột vào đây để mở rộng...
/)/ếu dãy số hay chữ cái í đang được ai đó cố tình đã xếp giảm dần & nhiệm vụ bây chừ phải làm ngược lại thì phải tăng iZ đến một số thích ứng ấy chứ!

/(hông phải tình cờ mình đưa ra con số 19 đâu Digita à! Con số thực nghiệm đó! Chỉ có điều tìm ra được số í tối ưu thì mình chưa biết giải thuật;
Đã lâu lắm rồi, có quyễn sách nói giải thuật này mà mình không còn trong kho bộ nhớ cũ kĩ của mình nữa; Họ có giải thuật sao đó chỉ dùng tối đa 7 cho tất cả thay vì 19 như mình (mà chỉ với 26 kí tự/kí số!)
Mình sẽ thử tiếp với toàn bộ 36 chữ cái & kí số xem sao;
Rất mong các bạn cho biết hướng cải tiến thuật toán này
)-(in cảm ơn!
}}}}}
BS
Mã: 
Option Explicit:            Option Base 1[b]

Sub SortMatrix() [/b]
 Dim iDem, Temp, iJ As Integer, iZ As Integer
 ReDim Mang(100)
 
 Range("D2:E120").ClearContents
 For iJ = 1 To 100
    Randomize:              iZ = 48 + Int(100 * Rnd())
    Mang(iJ) = Chr(iZ):     Cells(iJ + 1, 4) = Chr(iZ)
 Next iJ
 iDem = InputBox("HAY NHAP SO DEM:", , "50")
 Cells(2, 3) = iDem
 For iZ = 1 To iDem
    For iJ = 1 To 99
        Temp = Mang(iJ)
        If Mang(iJ + 1) < Temp Then
            Mang(iJ) = Mang(iJ + 1)
            Mang(iJ + 1) = Temp
        End If
 Next iJ, iZ
 
 For iJ = 1 To 100
    Cells(iJ + 1, 5) = Mang(iJ)
 Next iJ
 [b]
End Sub [/b]
 
Lần chỉnh sửa cuối:
Upvote 0
Ô mình lộn. Cần 1 biến số để có 1 vòng loop nữa mới sort đúng như code đầu tiên.
 
Upvote 0
Đã thử rồi anh ạ. Sau đây là code chỉnh sửa đôi chút dựa theo code anh viết ra. Anh coi xem nhá:

Sub SortAscend()
Dim Mang, temp, iJ, iZ, Lrow As Integer
Lrow = Range("A1").End(xlD wn).Row
Mang = Range("A1:A" & Lrow)
Range("B1:B" & Lrow).ClearContents

For iZ= 0 To Lrow
For iJ = 1 To Lrow - 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
Next iZ

For iJ = 1 To Lrow
Cells(iJ, 2) = Mang(iJ, 1)
Next iJ
End Sub
Nhấp chuột vào đây để mở rộng...

Còn sort tứ lớn tới nhỏ thì thử code sau:

Sub SortDescend()
Dim Mang, temp, temp2, iJ, Lrow As Integer, i As Integer
Lrow = Range("A1").End(xlDown).Row
Mang = Range("A1:A" & Lrow)
Range("B1:B" & Lrow).ClearContents

For i = 1 To UBound(Mang, 1) - 1
For iJ = i + 1 To UBound(Mang, 1)
If Mang(i, 1) < Mang(iJ, 1) Then
temp = Mang(iJ, 1)
temp2 = Mang(iJ, 1)
Mang(iJ, 1) = Mang(i, 1)
Mang(iJ, 1) = Mang(i, 1)
Mang(i, 1) = temp
Mang(i, 1) = temp2
End If
Next iJ
Next i

For iJ = 1 To Lrow
Cells(iJ, 2) = Mang(iJ, 1)
Next iJ
End Sub
Nhấp chuột vào đây để mở rộng...

Cái code sau thì tôi thữ sơ sơ. Nếu có trục trặc thì cho tôi biết coi lạii sau.

Mến
 
Upvote 0
Cảm ơn bác Digita và bác SA nhiều.

Các bác cho hỏi là cái Sub này có thể biến thành 1 hàm được không ạ ??
VD em hàm của nó là SX(Mang)

Sau đó chỉ cần gọi SX(MangTemp) là mảng temp sẽ được sắp xếp lại.

Thực ra cũng là cái mảng DS Duy nhất ở trên, em muốn sắp xếp lại nó trước khi gắn vào hàm. Chèn đoạn code vào cũng được, tuy nhiên nếu sử dụng nhiều lần ở những module khác nhau thì viết lại ngại quá,.--=0

Cảm ơn các bác nhiều.

Hy vọng được gặp 2 bác!!

Thân!
 
Upvote 0
Cái này tôi học từ NVSON và Digita, lấy ds duy nhất -> array - sort và gán lại vào sh, tôi chả biết làm UDF. Không dùng công cụ unique của AF.
PHP: 
Option Explicit
Dim rngMyRange As Range, ListSort As Range
Dim MyArray()
Dim i As Long, j As Long, x As Long, y As Long
Public Sub SortUniqueArray()
With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
End With
Set rngMyRange = Range("A1", Range("A10000").End(xlUp))
j = 0
For i = 1 To rngMyRange.Rows.Count
    x = WorksheetFunction.CountIf(Range(rngMyRange.Cells(1, 1), rngMyRange.Cells(i, 1)), rngMyRange.Cells(i, 1))
    If x = 1 Then 'neu tim thay 1 lan
        j = j + 1
        ReDim Preserve MyArray(1 To j)
        MyArray(j) = rngMyRange.Cells(i, 1)
    End If
Next i
y = UBound(MyArray())
Set ListSort = Range("B1:B" & y)
With ListSort
    .ClearContents
    .Value = Application.WorksheetFunction.Transpose(MyArray)
    .Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlNo, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
End With
Set ListSort = Nothing
Set rngMyRange = Nothing
With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
End With
End Sub
Đính kèm file. Các bạn xem thử liệu có nhanh hơn AF không.
Sửa lại thêm j = 0 sau dòng
End With
Set rngMyRange = Range("A1", Range("A10000").End(xlUp))
j = 0
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
ThuNghi đã viết:
Cái này tôi học từ NVSON và Digita, lấy ds duy nhất -> array - sort và gán lại vào sh, tôi chả biết làm UDF. Không dùng công cụ unique của AF.

[/php] Đính kèm file. Các bạn xem thử liệu có nhanh hơn AF không.
Nhấp chuột vào đây để mở rộng...

Cái của bác cũng rất tốt, tuy nhiên vẫn phải dựa vào 1 range trên sheet (vì vậy mới sort được). Ý em nói là không dựa vào sheet mà vẫn sort được cơ.

Cảm ơn bác nhiều!!

Thân!
 
Upvote 0
Mr Okebab đã viết:
Các bác cho hỏi là cái Sub này có thể biến thành 1 hàm được không ạ ??
VD em hàm của nó là SX(Mang)
Sau đó chỉ cần gọi SX(MangTemp) là mảng temp sẽ được sắp xếp lại.
Hy vọng được gặp 2 bác!!

Thân!
Nhấp chuột vào đây để mở rộng...
Thì còn gang tất nữa đến thiên đàn thôi mà Bắp;
Thì thấy Bắp đang nghiền ngẫm về hàm mảng í thôi!
Này nha
Dòng lênh cuối sẽ là
Mã: 
 SotMatrix = Temp
dòng lệnh này thay cho các dòng lệnh trong vòng lặp cuồi gán dãy vô lại các ô!
Thử xem, mình chưa thử à nha! (nó không phụ thuộc vô Bắp cung cấp vô là ~ ô theo hàng hay theo cột, nó sẽ trả về giống như giaitrinhBac2 zậy (đoán thôi nha, Bắp tự đi!!)
 
Upvote 0
Được em chết liền đấy.

bác thử luôn cho em đi!!

Cảm ơn nhiều!!

Thân!
 
Upvote 0
Anh chị em ơi, tập trung lại Bắp đãi 1 chầu 'Bàu đá' chết bỏ nào!

Mã: 
Option Explicit:            Option Base 1[b]

[COLOR="Blue"]'Hàm này xếp theo cột; mới chỉ là phần tăng dần!
' Thử cung cấp hàm 1 cột dữ liệu có  kí tự & kí sô khoảng < 20 đơn vị! [/COLOR]

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)
     
  For iZ = 1 To 20
  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
  
  iZ = SortMatrix
  For iJ = 1 To iZ
    MDLieu(iJ, 1) = Mang(iJ, 1)
  Next iJ
  SortMatrix = MDLieu[b]
  
End Function[/b]
 
Lần chỉnh sửa cuối:
Upvote 0
SA_DQ đã viết:
Mã: 
Option Explicit:            Option Base 1[B]

[COLOR=Blue]'Hàm này xếp theo cột; mới chỉ là phần tăng dần!
' Thử cung cấp hàm 1 cột dữ liệu có  kí tự & kí sô khoảng < 20 đơn vị! [/COLOR]

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)
     
  For iZ = 1 To 20
  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
  
  iZ = SortMatrix
  For iJ = 1 To iZ
    MDLieu(iJ, 1) = Mang(iJ, 1)
  Next iJ
  SortMatrix = MDLieu[B]
  
End Function[/B]
Nhấp chuột vào đây để mở rộng...

Hàm của bác là cho 1 range, còn áp dụng cho 1 mảng lại không được (Như VD MangTemp() của em trên kia)

Trong khi chờ đợi bác giúp em, em đành tiến hành theo kiểu củ chuối vậy :
Đây là hàm trả về Danh Sách đã được sắp xếp tăng dần :

PHP: 
Function DanhSachMSX(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
    'Loc Danh Sach
    For i = 1 To m
        If i = 1 Then ' Gan PT dau tien
            Mang(1, 0) = MangTemp(1, 0)
        Else
            For i1 = 1 To i - 1 ' Xem co nho hon GT nao trong Mang khong ??
                If LCase(MangTemp(i, 0)) < LCase(Mang(i1, 0)) Then Tim = True: Exit For
            Next i1
            
            If Tim = False Then ' Khong co : Cho xuong duoi Danh Sach
                Mang(i, 0) = MangTemp(i, 0)
            Else ' Neu co :
                For i2 = i To i1 + 1 Step -1
                    Mang(i2, 0) = Mang(i2 - 1, 0) 'Dich chuyen danh sach xuong 1 nac
                Next i2
                Mang(i1, 0) = MangTemp(i, 0) ' Cho phan tu vao DS
            End If
        End If
        Tim = False
    Next
    DanhSachMSX = Mang()
    Set Ma = Nothing
    Application.ScreenUpdating = True
End Function


Mong được góp ý!!

Thân!
 

File đính kèm

Upvote 0
:-=
Các bác cho hỏi là cái Sub này có thể biến thành 1 hàm được không ạ ?? VD em hàm của nó là SX(Mang) Sau đó chỉ cần gọi SX(MangTemp) là mảng temp sẽ được sắp xếp lại.
Thực ra cũng là cái mảng DS Duy nhất ở trên, em muốn sắp xếp lại nó trước khi gắn vào hàm. Chèn đoạn code vào cũng được, tuy nhiên nếu sử dụng nhiều lần ở những module khác nhau thì viết lại ngại quá, Cảm ơn các bác nhiều. !
Nhấp chuột vào đây để mở rộng...
Hàm cùa mình xếp toàn bộ danh sách lại mà;
Như ví dụ của Bắp đưa lên, mình đã thử rồi & kết quả như sau:
Lấy cột E còn trống, chọn & kích hoạt các ô từ E2 đến E156; & ínert hàm của mình & kết thúc = tổ hợp 3 fìm là nó sẽ xếp cho Bắp mà!

Mình chưa viết được hàm từ 1 Ds có trùng, xếp lại theo trật tự 1 danh sách duy nhất! (mình nghĩ cũng sẽ viết được luôn!);
Mình sẽ đưa file lên bổ sung sau!
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
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é. :))
 
Upvote 0
Lập danh sách duy nhất & xếp lại theo chiều tăng dần đây, đổi Bàu đá không?!

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!
 
Upvote 0
SA_DQ đã viết:
:-=
Hàm cùa mình xếp toàn bộ danh sách lại mà;
Như ví dụ của Bắp đưa lên, mình đã thử rồi & kết quả như sau:
Lấy cột E còn trống, chọn & kích hoạt các ô từ E2 đến E156; & ínert hàm của mình & kết thúc = tổ hợp 3 fìm là nó sẽ xếp cho Bắp mà!

Mình chưa viết được hàm từ 1 Ds có trùng, xếp lại theo trật tự 1 danh sách duy nhất! (mình nghĩ cũng sẽ viết được luôn!);
Mình sẽ đưa file lên bổ sung sau!
Nhấp chuột vào đây để mở rộng...

Bác chưa hiểu ý của em.
Hàm của bác là phải chạy ra một vùng trong Sheet thì mới sử dụng được

Theo như Code của em thì em đã lọc ra được Mangtemp() chứa DS duy nhất rồi.
Trước khi gán DanhSachMSX = MangTemp() thì em muốn sắp xếp lại cái MangTemp này.
Sau đó mới gán DanhSachMSX = MangTemp()

Đây chính là đoạn em lọc (hơi chuối) để sắp xếp lại mảng này.
PHP: 
   'Loc Danh Sach
    For i = 1 To m
        If i = 1 Then ' Gan PT dau tien
            Mang(1, 0) = MangTemp(1, 0)
        Else
            For i1 = 1 To i - 1 ' Xem co nho hon GT nao trong Mang khong ??
                If LCase(MangTemp(i, 0)) < LCase(Mang(i1, 0)) Then Tim = True: Exit For
            Next i1
            
            If Tim = False Then ' Khong co : Cho xuong duoi Danh Sach
                Mang(i, 0) = MangTemp(i, 0)
            Else ' Neu co :
                For i2 = i To i1 + 1 Step -1
                    Mang(i2, 0) = Mang(i2 - 1, 0) 'Dich chuyen danh sach xuong 1 nac
                Next i2
                Mang(i1, 0) = MangTemp(i, 0)  Cho phan tu vao DS
            End If
        End If
        Tim = False
    Next
    DanhSachMSX = Mang()

Em muốn thay đoạn này bằng đoạn
  1. MangTemp() = SortMatrix(MangTemp)
  2. Hoặc : DanhSachMSX = SortMatrix(MangTemp)
  3. Hay một cái gì gì đó tương tự . . . ???
Thân!
 
Upvote 0
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é. :))
Nhấp chuột vào đây để mở rộng...

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.
Nhấp chuột vào đây để mở rộng...

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!
Nhấp chuột vào đây để mở rộng...

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òng và Vă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ất và Sắ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.
Nhấp chuột vào đây để mở rộng...

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 ??
Nhấp chuột vào đây để mở rộ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)
Nhấp chuột vào đây để mở rộng...
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òng và Văn Phòng
Nhấp chuột vào đây để mở rộ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ất và Sắp xếp. Vậy thì làm cái nào trước thì nhanh hơn ??
Thân!
Nhấp chuột vào đây để mở rộng...
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.
Nhấp chuột vào đây để mở rộng...

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à)
Nhấp chuột vào đây để mở rộng...

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à)
Nhấp chuột vào đây để mở rộng...

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.

http://www.freevbcode.com/ShowCode.asp?ID=3977
Nhấp chuột vào đây để mở rộng...

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
Nhấp chuột vào đây để mở rộng...

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
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

Q
Không chỉnh sửa, copy được hình ảnh trong file excel. (3 người xem)
Trả lời
6
Đọc
4K
thaivanthao
T
L
Nhờ giúp file word
Trả lời
1
Đọc
72
minhminh27
minhminh27
GPE-Trợ Lý
[GPE] TASKSHOW 14: TỪ BẢNG TÍNH ĐẾN BÁO CÁO ĐỘNG - BẮT ĐẦU VỚI LOOKER STUDIO
    • Thích
Trả lời
1
Đọc
11K
GPE-Trợ Lý
GPE-Trợ Lý
dungluyen2119
  • Question Question
Code VBA để tính tổng theo chiều ngang mà số cột không cố định
Trả lời
5
Đọc
252
dungluyen2119
dungluyen2119
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (2 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
2 3 4
Trả lời
390
Đọc
46K
phdong
P
8
Theo dõi bán hàng
Trả lời
10
Đọc
289
84huong
8
L
  • Question Question
Nhờ sửa code ChrW ()
Trả lời
2
Đọc
89
le_vis
L
N
  • Question Question
Hỗ trợ tiếng việt trong macro
Trả lời
12
Đọc
521
Quang_Hải
Quang_Hải
D
xin hỏi về lỗi mô đun ẩn.
Trả lời
6
Đọc
291
du trung kien
D
haohvnh
Lỗi hàm SUM không hiển thị ra kết quả
Trả lời
19
Đọc
45K
ptm0412
ptm0412
minhduc1o2
Hình ảnh bị lỗi #VALUE
Trả lời
5
Đọc
167
minhduc1o2
minhduc1o2
ongke0711
  • Question Question
Tra cứu thông tin mã số thuế (cập nhật lại code cũ)
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
5
Đọc
303
ongke0711
ongke0711
befaint
Chia sẻ tâm tư, xả nỗi lòng (1 người xem)
    • Thích
6 7 8
Trả lời
761
Đọc
61K
SA_DQ
SA_DQ
S
  • Question Question
Object.close và Set Object = nothing (1 người xem)
Trả lời
14
Đọc
1K
nguyendang95
N
H
Lỗi khi sort data xin được hỗ trợ
Trả lời
2
Đọc
117
hunglq48
H
Nguyenkhang2404
Tính định mức sản phẩm
    • Chấp nhận
Trả lời
9
Đọc
369
Nguyenkhang2404
Nguyenkhang2404
T
Ngắt kết nối với tệp lệnh đính kèm (1 người xem)
Trả lời
2
Đọc
134
TungXauGiai
T
ongke0711
  • Question Question
Trộn dữ liệu từ Excel sang Word mở rộng (phiên bản ongke0711)
    • Thích
    • Yêu thích
    • Cảm ơn
2 3
Trả lời
277
Đọc
35K
joker102
J
S
tỷ lệ % không khớp khi cộng tổng
Trả lời
2
Đọc
109
snoobcool
S
D
Tên sheet bị che khuất khi thực hiện sửa tên sheet
Trả lời
1
Đọc
272
PhamMaiTB
P
Xem thêm…

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

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom