Nhờ các anh chị khắc phục giúp em lỗi "Subscript out of range"

Nguyen Rem · 15/4/22

Anh chị vào Modul2 chạy thử code giúp em với ^^ . Mong các anh chị tìm và giải thích lỗi sai giúp em
Em muốn là khi em truyền cho đối số cho Sub "Test" số 1 và một mảng số thì nó sẽ xắp xếp các số trong mảng theo chiều tăng dần .
Ngược lại Nếu truyền một số bất kỳ thì xắp xếp mảng theo chiều giảm dần
Em cảm ơn Anh chị nhiều

thnghiachau · 15/4/22

Nguyen Rem đã viết:
Anh chị vào Modul2 chạy thử code giúp em với ^^ . Mong các anh chị tìm và giải thích lỗi sai giúp em
Em muốn là khi em truyền cho đối số cho Sub "Test" số 1 và một mảng số thì nó sẽ xắp xếp các số trong mảng theo chiều tăng dần .
Ngược lại Nếu truyền một số bất kỳ thì xắp xếp mảng theo chiều giảm dần
Em cảm ơn Anh chị nhiều
View attachment 274480

Mã:

Public Sub Test(ByVal L As Integer, ByRef A() As Variant)
Dim i, j, jc, t As Integer
jc = i

For i = LBound(A,1) To UBound(A,1) - 1
    For j = LBound(A, 1) + 1 To UBound(A, 1) + 1
    If L = 1 Then
      If A(jc, 1) > A(i, 1) Then
        jc = j
      End If
    Else
      If A(jc, 1) < A(i, 1) Then
        jc = j
      End If
    End If
    Next j
Next i
    If jc <> i Then
        A(i, 1) = t
        A(i, 1) = A(jc, 1)
        A(jc, 1) = t
    End If
End Sub

Private Sub Test1()
Dim Rng As Range, B(), i As Integer
Set Rng = Range("E2:E10")
B = Rng.Value
Call Test(1, B)

For i = 1 To 8
    Cells(1, i) = B(i, 1)
    MsgBox B(i, 1)
Next i

End Sub

màng A /B là mảng 2 chiều B = Range("E2:E10").Value => mảng 1 cột 9 hàng

CHAOQUAY · 15/4/22

Nguyen Rem đã viết:
Anh chị vào Modul2 chạy thử code giúp em với ^^ . Mong các anh chị tìm và giải thích lỗi sai giúp em
Em muốn là khi em truyền cho đối số cho Sub "Test" số 1 và một mảng số thì nó sẽ xắp xếp các số trong mảng theo chiều tăng dần .
Ngược lại Nếu truyền một số bất kỳ thì xắp xếp mảng theo chiều giảm dần
Em cảm ơn Anh chị nhiều

Để chạy được, bạn sửa như bên dưới. Lỗi chủ yếu nằm tại các dòng đã sửa thành comment

Mã:

'Public Sub Test(ByVal L As Integer, ByRef A() As Variant)
Private Sub Test(ByVal L As Integer, ByRef A() As Variant)
Dim i, j, jc, t As Integer
jc = i

For i = LBound(A, 1) To UBound(A, 1) - 1
    'For j = LBound(A, 1) + 1 To UBound(A, 1) + 1
    For j = LBound(A, 1) + 1 To UBound(A, 1)
    If L = 1 Then
      'If A(jc, 1) > A(i, 1) Then
      If A(j, 1) > A(i, 1) Then
        jc = j
      End If
    Else
      'If A(jc, 1) < A(i, 1) Then
      If A(j, 1) < A(i, 1) Then
        jc = j
      End If
    End If
    Next j
Next i
    If jc <> i Then
        A(i, 1) = t
        A(i, 1) = A(jc, 1)
        A(jc, 1) = t
    End If
End Sub

'Private Sub Test1()
Public Sub Test1()
Dim Rng As Range, B(), i As Integer
Set Rng = Range("E2:E10")
B = Rng.Value
Call Test(1, B)

For i = 1 To 8
    Cells(1, i) = B(i, 1)
    MsgBox B(i, 1)
Next i

End Sub

batman1 · 15/4/22

Ngoài lỗi ra thì code này đâu có sắp xếp. Code hơi bị lạ.

Nguyen Rem · 15/4/22

batman1 đã viết:
Ngoài lỗi ra thì code này đâu có sắp xếp. Code hơi bị lạ

Em chào anh ^^ hí hí
Em tư duy bài này như sau ạ :
Ví dụ
Mình có một mảng A ( 1 To 5) lần lượt gồm A(1) = 5 , A(2) = 9 , A(3) = 1 , A(4) = 6 , A(5) = 10

5 , 9 , 1 , 6 , 10
Yêu cầu xắp xếp từ bé đến lớn

Giả sử số 5 là số bé nhất . Mà 5 < 9 ==> Chọn 5 là số bé nhất
Tiếp tục 5 so sánh với 1 . Mà 1 < 5 => chọn 1 là số bé nhất
Tiếp tục 1 so sánh với 6 . Mà 1 < 6 => chọn 1 là số bé nhất
Tiếp tục so sánh với 10 . 1 < 10 ==> Cuối cùng vẫn chọn 1 là số bé nhất .
Sau cùng ta hoán đổi vị trí của 1 và 5
Nhìn tổng thể ta thu được:
5 , 9 , 1 , 6 , 10
1 , 9 , 5 , 6 , 10

Tiếp Tục ta áp dụng với dãy mà ( 1 , 9 , 5 , 6 ,10 ) mà mình vừa thu được
Giả sử số 9 là số bé nhất . Mà 9 > 5 ==> chọn 5 là số bé nhất
Tiếp tục 5 so sánh với 6 . Mà 5 < 6 => chọn 5 là số bé nhất
Tiếp tục 5 so sánh với 10 . Mà 5 < 10 => Cuối cùng vẫn chọn 5 là số bé nhất .
Sau cùng ta hoán đổi vị trí của 5 với 9
Nhìn tổng thể ta thu được:
5 , 9 , 1 , 6 , 10
1 , 9 , 5 , 6 , 10
1, 5 , 9 , 6 , 10

Sau cùng ta thu được

5 , 9 , 1 , 6 , 10
1, 9 , 5 , 6 , 10
1, 5, 9 , 6 , 10
1, 5, 6 , 9 , 10
1, 5, 6 , 9 , 10
1, 5, 6 , 9 , 10

Mảng A cuối cùng thu được :
1 , 5 , 6 , 9 , 10

Nguyen Rem · 15/4/22

thnghiachau đã viết:

Mã:

Public Sub Test(ByVal L As Integer, ByRef A() As Variant)
Dim i, j, jc, t As Integer
jc = i

For i = LBound(A,1) To UBound(A,1) - 1
    For j = LBound(A, 1) + 1 To UBound(A, 1) + 1
    If L = 1 Then
      If A(jc, 1) > A(i, 1) Then
        jc = j
      End If
    Else
      If A(jc, 1) < A(i, 1) Then
        jc = j
      End If
    End If
    Next j
Next i
    If jc <> i Then
        A(i, 1) = t
        A(i, 1) = A(jc, 1)
        A(jc, 1) = t
    End If
End Sub

Private Sub Test1()
Dim Rng As Range, B(), i As Integer
Set Rng = Range("E2:E10")
B = Rng.Value
Call Test(1, B)

For i = 1 To 8
    Cells(1, i) = B(i, 1)
    MsgBox B(i, 1)
Next i

End Sub

màng A /B là mảng 2 chiều B = Range("E2:E10").Value => mảng 1 cột 9 hàng

anh ơi ! Em khác phục theo cách của anh rồi nhưng nó vẫn không được anh ạ . Anh giúp em xem lại lần nữa với ạ híhi

batman1 · 15/4/22

Nguyen Rem đã viết:
Em tư duy bài này như sau ạ :
Ví dụ
Mình có một mảng A ( 1 To 5) lần lượt gồm A(1) = 5 , A(2) = 9 , A(3) = 1 , A(4) = 6 , A(5) = 10

Chắc chắn code không làm cái bạn định làm.

Thôi xét thế này cho nhanh. Trong trường hợp tổng quát sẽ phải có nhiều lần đánh tráo từng cặp. Vd. trong dãy của bạn thì bạn sẽ đánh tráo cặp (1, 5)? Cứ cho là vậy đi vì tôi không có hứng phân tích code của bạn. Tiếp theo còn đánh tráo nữa. Nhưng nhìn code thì trong 2 vòng FOR không có chỗ nào đánh tráo 2 phần tử của mảng. Chỉ sau 2 vòng FOR, và cũng chỉ trong trường hợp "cái gọi là" jc <> i mới có việc đánh tráo 1 cặp duy nhất. Trong trường hợp tổng quát thì rõ ràng không thể sắp xếp chỉ bằng 1 lần đánh tráo cho dù cặp cần đánh tráo là cặp nào.

Mà bàn gì cho mất công. Cứ chạy code rồi xem dữ liệu có được sắp xếp không thì biết.

Bạn cứ tìm tòi đi. Về bubble sort thì có thể như ở dưới.

----------------
Nếu tôi không nhầm lẫn thì vd. bubble sort

Mã:

Sub sort(A(), ByVal AtoZ As Boolean)
Dim i As Long, j As Long, temp, hoandoi As Boolean
    For i = UBound(A, 1) To LBound(A, 1) Step -1
        For j = LBound(A, 1) To i - 1
            If AtoZ Then
                hoandoi = A(j, 1) > A(j + 1, 1)
            Else
                hoandoi = A(j, 1) < A(j + 1, 1)
            End If
            If hoandoi Then
                temp = A(j + 1, 1)
                A(j + 1, 1) = A(j, 1)
                A(j, 1) = temp
            End If
        Next j
    Next i
End Sub

Public Sub Test1()
Dim Rng As Range, B()
    Set Rng = Range("E2:E10")
    B = Rng.Value
    Call sort(B, False)
    Range("F2:F10").Value = B
End Sub

Nguyen Rem đã viết:
anh ơi ! Em khác phục theo cách của anh rồi nhưng nó vẫn không được anh ạ . Anh giúp em xem lại lần nữa với ạ híhi

Bài 2 vẫn lỗi.

Public Sub Test(ByVal L As Integer, ByRef A() As Variant)
Dim i, j, jc, t As Integer
jc = i ' (A)

For i = LBound(A,1) To UBound(A,1) - 1
For j = LBound(A, 1) + 1 To UBound(A, 1) + 1
If L = 1 Then
If A(jc, 1) > A(i, 1) Then ' (B)
jc = j
End If
Else
If A(jc, 1) < A(i, 1) Then ' (C)

Tại (A) có jc = 0 do i = 0. Vì thế lần đầu tiên tại (B) hoặc ̣C) sẽ có lỗi do jc = 0. Không thể truy cập tới phần tử của mảng ở dòng 0. Mảng được lấy từ sheet theo cách "đó" luôn có chỉ số DÒNG và CỘT tính từ 1.

bebo021999 · 15/4/22

Thử củ chuối này xem:

PHP:

Option Explicit
Sub main()
Dim vung As Range, ib As String
Set vung = Range("E2:E9")
Call sapxep(vung, InputBox("Tang (1) hay Giam (0)?", "Sap xep", 1))
End Sub

Sub sapxep(ByRef vung As Range, Optional ByVal sapxep As Integer = 1)
Dim i&, j&, temp&, arr()
arr = vung '
    For i = 1 To vung.Count - 1
        For j = i + 1 To vung.Count
            If IIf(sapxep = 1, arr(i, 1) > arr(j, 1), arr(i, 1) < arr(j, 1)) Then
                temp = arr(j, 1)
                arr(j, 1) = arr(i, 1)
                arr(i, 1) = temp
            End If
        Next
    Next
    Range("E2").Resize(vung.Count, 1).Value = arr
End Sub

Nguyen Rem · 15/4/22

batman1 đã viết:
Chắc chắn code không làm cái bạn định làm.

Thôi xét thế này cho nhanh. Trong trường hợp tổng quát sẽ phải có nhiều lần đánh tráo từng cặp. Vd. trong dãy của bạn thì bạn sẽ đánh tráo cặp (1, 5)? Cứ cho là vậy đi vì tôi không có hứng phân tích code của bạn. Tiếp theo còn đánh tráo nữa. Nhưng nhìn code thì trong 2 vòng FOR không có chỗ nào đánh tráo 2 phần tử của mảng. Chỉ sau 2 vòng FOR, và cũng chỉ trong trường hợp "cái gọi là" jc <> i mới có việc đánh tráo 1 cặp duy nhất. Trong trường hợp tổng quát thì rõ ràng không thể sắp xếp chỉ bằng 1 lần đánh tráo cho dù cặp cần đánh tráo là cặp nào.

Mà bàn gì cho mất công. Cứ chạy code rồi xem dữ liệu có được sắp xếp không thì biết.

Bạn cứ tìm tòi đi. Về bubble sort thì có thể như ở dưới.

----------------
Nếu tôi không nhầm lẫn thì vd. bubble sort

Mã:

Sub sort(A(), ByVal AtoZ As Boolean) Dim i As Long, j As Long, temp, hoandoi As Boolean For i = UBound(A, 1) To LBound(A, 1) Step -1 For j = LBound(A, 1) To i - 1 If AtoZ Then hoandoi = A(j, 1) > A(j + 1, 1) Else hoandoi = A(j, 1) < A(j + 1, 1) End If If hoandoi Then temp = A(j + 1, 1) A(j + 1, 1) = A(j, 1) A(j, 1) = temp End If Next j Next i End Sub Public Sub Test1() Dim Rng As Range, B() Set Rng = Range("E2:E10") B = Rng.Value Call sort(B, False) Range("F2:F10").Value = B End Sub

Bài 2 vẫn lỗi.

Tại (A) có jc = 0 do i = 0. Vì thế lần đầu tiên tại (B) hoặc ̣C) sẽ có lỗi do jc = 0. Không thể truy cập tới phần tử của mảng ở dòng 0. Mảng được lấy từ sheet theo cách "đó" luôn có chỉ số DÒNG và CỘT tính từ 1.

Anh ơi ! Em vừa sửa xong lại code của mình.
Anh có thể vào Modul : "Modul1" chạy thử . Và cho em hỏi tại sao sub Test2 bị lỗi ở đâu mà không chạy được ạ . Em vẫn chưa hình dung ra lỗi của mình mắc phải

Maika8008 · 15/4/22

Nguyen Rem đã viết:
Anh ơi ! Em vừa sửa xong lại code của mình.
Anh có thể vào Modul : "Modul1" chạy thử . Và cho em hỏi tại sao sub Test2 bị lỗi ở đâu mà không chạy được ạ . Em vẫn chưa hình dung ra lỗi của mình mắc phải

Lỗi của bạn mọi người đã nhắc là bạn dùng chỉ số mảng sai:
Thay vì If A(jc) > A(j) Then thì bạn phải viết là If A(jc, 1) > A(j, 1) Then
Lý do: Khi lấy gán khối cell cho mảng thì luôn là mảng 2 chiều. Mảng A ở trên có nhiều dòng và 1 cột.

Nguyen Rem · 15/4/22

Dạ vâng ạ ! Em cảm ơn mọi người rất nhiều em đã khắc phục được lỗi rồi ạ
Cảm ơn mọi người đã dành thời gian khắc phục lỗi giúp em ^^

HieuCD · 15/4/22

Nguyen Rem đã viết:
Anh chị vào Modul2 chạy thử code giúp em với ^^ . Mong các anh chị tìm và giải thích lỗi sai giúp em
Em muốn là khi em truyền cho đối số cho Sub "Test" số 1 và một mảng số thì nó sẽ xắp xếp các số trong mảng theo chiều tăng dần .
Ngược lại Nếu truyền một số bất kỳ thì xắp xếp mảng theo chiều giảm dần
Em cảm ơn Anh chị nhiều
View attachment 274480

Tinh gọn code và tăng tốc xử lý khi dữ liệu nhiều. Chay sub Main với 10.000 dòng dữ liệu

Mã:

Sub Main()
  Dim arr(), tg#
  tg = Timer
  arr = Range("A1:A10000").Value
  Call CreateSort(arr)
  'Call CreateSort(arr, True)
  'Call CreateSort(arr, False)
  Range("b1:b10000").Value = arr
  MsgBox ("Thoi gian chay code: " & Chr(10) & Timer - tg & " giay")
End Sub

Sub CreateSort(ByRef arr(), Optional ByVal a_z As Boolean = True)
  Dim i&, r&, t&, tmp
  For i = 1 To UBound(arr) - 1
    tmp = arr(i, 1)
    t = 0
    For r = i + 1 To UBound(arr)
      If (tmp > arr(r, 1)) = a_z Then t = r: tmp = arr(r, 1)
    Next r
    If t > 0 Then
      tmp = arr(i, 1)
      arr(i, 1) = arr(t, 1)
      arr(t, 1) = tmp
    End If
  Next i
End Sub

batman1 · 15/4/22

Nguyen Rem đã viết:
Dạ vâng ạ ! Em cảm ơn mọi người rất nhiều em đã khắc phục được lỗi rồi ạ
Cảm ơn mọi người đã dành thời gian khắc phục lỗi giúp em ^^

Code bài #7 là bubble sort, thuộc loại chậm. Có nhiều kiểu sort.

Quick sort rất nhanh. Tôi viết gần 10 năm trước nhưng tiếc là tập tin đính kèm không còn.

Hàm dùng cho sắp xếp mảng - nhờ test hộ và góp ý

Tôi đã viết từ lâu một hàm để sắp xếp có những chức năng: cho phép sắp xếp tới 3 cột - bắt chước Excel mà (1 cột phải có, 2 cột là tùy chọn), tăng giảm mỗi cột riêng biệt, sắp xếp cả cột có tiếng Việt, thậm chí có thể chọn phân biệt chữ hoa, thường...

www.giaiphapexcel.com

Nếu bạn muốn nghiên cứu thì vd. sort mảng 1 chiều. Đảm bảo tốc độ vũ trụ luôn.

Mã:

Public Sub QuickSort1DArray(Arr, iLo As Long, iHi As Long, ByVal sortAtoZ As Boolean)
'    Arr la mang 1 chieu can sap xep
'    sortAtoZ xac dinh cach sap xep tang hay giam
'    chi sap xep nhung dong trong khoang iLo - iHi, bo qua cac dong khac. Vd. ta co mang Arr co chi so tinh tu 1,
'    va ta chi muon sap xep cac dong tu 3 den cuoi, con dong 1 va 2 de nguyen vi tri, thi truyen iLo = 3, iHi = ubound(arr)
'    Neu muon sap xep tu dong 1 toi cuoi thi iLo = 1, iHi = Ubound(Arr). Mot truong hop khong sort ca mang ma chi 1 phan:
'    mang co du lieu va TIEU DE. Do ta khong sort tieu de nen ta truyền iLo = 2 (mang co chi so tinh tu 1), iHi = UBound(Arr).

'    sau khi code duoc thuc hien thi mang dau vao Arr da duoc sap xep
Dim Lo As Long, Hi As Long, iMid, DoChange As Boolean, s

    Do
        Lo = iLo
        Hi = iHi
       
        iMid = Arr((Lo + Hi) \ 2)
        Do
            If sortAtoZ Then
                Do While Arr(Lo) < iMid
                    Lo = Lo + 1
                Loop
                Do While Arr(Hi) > iMid
                    Hi = Hi - 1
                Loop
            Else
                Do While Arr(Lo) > iMid
                    Lo = Lo + 1
                Loop
                Do While Arr(Hi) < iMid
                    Hi = Hi - 1
                Loop
            End If
           
            If Lo <= Hi Then
                If sortAtoZ Then
                    DoChange = (Arr(Lo) > Arr(Hi))
                Else
                    DoChange = (Arr(Lo) < Arr(Hi))
                End If
                If DoChange Then
                    s = Arr(Lo)
                    Arr(Lo) = Arr(Hi)
                    Arr(Hi) = s
                End If
               
                Lo = Lo + 1
                Hi = Hi - 1
            End If
        Loop Until Lo > Hi
        If Hi > iLo Then QuickSort1DArray Arr, iLo, Hi, sortAtoZ
        iLo = Lo
    Loop Until Lo >= iHi
End Sub

Maika8008 · 15/4/22

Tốc độ ánh sáng luôn. Oai thì oai cho tới cùng, không nên tiết kiệm kkkkkkk

Nguyen Rem · 16/4/22

batman1 đã viết:
Code bài #7 là bubble sort, thuộc loại chậm. Có nhiều kiểu sort.

Quick sort rất nhanh. Tôi viết gần 10 năm trước nhưng tiếc là tập tin đính kèm không còn.

Hàm dùng cho sắp xếp mảng - nhờ test hộ và góp ý

Tôi đã viết từ lâu một hàm để sắp xếp có những chức năng: cho phép sắp xếp tới 3 cột - bắt chước Excel mà (1 cột phải có, 2 cột là tùy chọn), tăng giảm mỗi cột riêng biệt, sắp xếp cả cột có tiếng Việt, thậm chí có thể chọn phân biệt chữ hoa, thường...

www.giaiphapexcel.com

Nếu bạn muốn nghiên cứu thì vd. sort mảng 1 chiều. Đảm bảo tốc độ vũ trụ luôn.

Mã:

Public Sub QuickSort1DArray(Arr, iLo As Long, iHi As Long, ByVal sortAtoZ As Boolean) ' Arr la mang 1 chieu can sap xep ' sortAtoZ xac dinh cach sap xep tang hay giam ' chi sap xep nhung dong trong khoang iLo - iHi, bo qua cac dong khac. Vd. ta co mang Arr co chi so tinh tu 1, ' va ta chi muon sap xep cac dong tu 3 den cuoi, con dong 1 va 2 de nguyen vi tri, thi truyen iLo = 3, iHi = ubound(arr) ' Neu muon sap xep tu dong 1 toi cuoi thi iLo = 1, iHi = Ubound(Arr). Mot truong hop khong sort ca mang ma chi 1 phan: ' mang co du lieu va TIEU DE. Do ta khong sort tieu de nen ta truyền iLo = 2 (mang co chi so tinh tu 1), iHi = UBound(Arr). ' sau khi code duoc thuc hien thi mang dau vao Arr da duoc sap xep Dim Lo As Long, Hi As Long, iMid, DoChange As Boolean, s Do Lo = iLo Hi = iHi iMid = Arr((Lo + Hi) \ 2) Do If sortAtoZ Then Do While Arr(Lo) < iMid Lo = Lo + 1 Loop Do While Arr(Hi) > iMid Hi = Hi - 1 Loop Else Do While Arr(Lo) > iMid Lo = Lo + 1 Loop Do While Arr(Hi) < iMid Hi = Hi - 1 Loop End If If Lo <= Hi Then If sortAtoZ Then DoChange = (Arr(Lo) > Arr(Hi)) Else DoChange = (Arr(Lo) < Arr(Hi)) End If If DoChange Then s = Arr(Lo) Arr(Lo) = Arr(Hi) Arr(Hi) = s End If Lo = Lo + 1 Hi = Hi - 1 End If Loop Until Lo > Hi If Hi > iLo Then QuickSort1DArray Arr, iLo, Hi, sortAtoZ iLo = Lo Loop Until Lo >= iHi End Sub

úi ^^ giờ em mới để ý . Em cảm ơn anh nhiều . Em sẽ tìm hiểu sau ạ hí hí

HieuCD · 16/4/22

Nguyen Rem đã viết:
"truyền cho đối số cho Sub "Test" số 1 và một mảng số thì nó sẽ xắp xếp các số trong mảng theo chiều tăng dần .
Ngược lại Nếu truyền một số bất kỳ thì xắp xếp mảng theo chiều giảm dần"
Em cảm ơn Anh chị nhiều

Quick Sort tốc độ nhanh nhưng thuật toán khá phức tạp không dành cho người mới tập viết code, người tập viết code ban đầu chỉ cần viết chạy đúng khi trình độ nâng cao mới có khả năng tinh chỉnh rút gọn hoặc tăng tốc xử lý
Tìm trên Google có hàng loạt code của Tây na ná nhau, mượn ý tưởng và thêm vài lệnh tạo "code mới" góp vui với diễn đàn

Mã:

Sub QuickSort(arr, ByVal fRow As Long, ByVal eRow As Long, Optional ByVal a_z As Boolean = True)
'Sort mang 1 chieu "arr"
'fRow, eRow là thu tu dong Dau và dòng Cuoi cua mang "arr" duoc sort, cac dong nam ngoai khoang nay giu nguyen
'Mac dinh a_z = True la Sort A -> Z, neu a_z = False la Sort Z -> A
  Dim pVal, tVal, fR&, eR&, i&
  fR = fRow: eR = eRow
  pVal = arr(fRow)
  Do While fR <= eR
    If a_z Then
      Do While (arr(fR) < pVal)
        fR = fR + 1
      Loop
      Do While (pVal < arr(eR))
        eR = eR - 1
      Loop
    Else
      Do While (arr(fR) > pVal)
        fR = fR + 1
      Loop
      Do While (pVal > arr(eR))
        eR = eR - 1
      Loop
    End If
    If (fR <= eR) Then
      If (arr(fR) > arr(eR)) = a_z Then
        tVal = arr(fR)
        arr(fR) = arr(eR)
        arr(eR) = tVal
      End If
      fR = fR + 1
      eR = eR - 1
   End If
  Loop
  If (fRow < eR) Then Call QuickSort(arr, fRow, eR, a_z)
  If (fR < eRow) Then Call QuickSort(arr, fR, eRow, a_z)
End Sub

Chạy sub Main minh họa cách dùng sub "QuickSort"

Mã:

Sub Main()
  Dim arr, sArr, sRow&, i&, tg#, a_z As Boolean, n&
 
  sRow = 10000 'So dong du lieu
  a_z = True 'Sort tu A toi Z
  ReDim arr(1 To sRow)
  ReDim sArr(1 To sRow, 1 To 1)

  For i = 1 To sRow 'Tao du lieu ngau nhien
    arr(i) = Int(Rnd() * 10 + 1)
    sArr(i, 1) = arr(i)
  Next i
  Range("A1").Resize(sRow).Value = sArr 'Gan du lieu ngau nhien len Sheet
 
  Call QuickSort(arr, 1, sRow, a_z) 'Sort mang arr

  For i = 1 To sRow 'Gan ket qua Sort
    sArr(i, 1) = arr(i)
  Next i
  Range("B1").Resize(sRow).Value = sArr
End Sub

Code QuickSort có thể dùng làm nền để sort mảng 2 chiều với số cột điều kiện là 1, 2 ... n cột, và sort cho cả tiếng việt có dấu

batman1 · 16/4/22

Nguyen Rem đã viết:
úi ^^ giờ em mới để ý . Em cảm ơn anh nhiều . Em sẽ tìm hiểu sau ạ hí hí

Việc sắp xếp, cả sắp xếp tiếng Việt, tôi đã xét gần 10 năm trước rồi. Ý tưởng cũng có từ ngày đó, và viết code chính cũng ở ngày đó.

Tôi đã tỉa tót và công bố trong chủ đề sau. Ai cần tìm hiểu thì đọc bài #14, #30, #43.

Hàm sắp xếp mảng ngang dọc với Thuật toán QuickSort (sắp xếp Tiếng Việt) cho Excel

Hôm nay tôi lại chia sẻ cho các bạn các Hàm UDF được viết bằng VBA, nhằm mục đích để sắp xếp mảng một cách tối ưu nhất. HÀM UDF SẮP XẾP PHÂN TẦNG (ĐA HÀNG CỘT) Hàm VSORT và Thủ tục VSORTING - Sắp xếp dọc Hàm HSORT và Thủ tục HSORTING - Sắp xếp ngang Mục tiêu đạt được: Sắp xếp cả mảng ngang...

www.giaiphapexcel.com

Vấn đề sắp xếp là một trong những vấn đề có từ ngàn đời. Vì nhu cầu, vì bài toán sắp xếp có từ ngàn đời. Có những cái người ta có nhu cầu từ ngàn đời, nên người ta nghiên cứu từ ngàn đời, và thuật toán sắp xếp chính là một trong những thuật toán mà người học lập trình biết. Nó cũng giống như bài toán tìm lộ trình ngắn nhất trong các lộ trình. Vấn đề hàng ngàn năm vẫn chỉ là một, và thuật toán tìm lộ trình ngắn nhất cũng là thuật toán kinh điển. Chỉ còn mỗi việc là implement algorithm thôi.

Ở dưới là tập tin ví dụ.

Tài hèn sức mọn chỉ có vậy thôi.

Ở chủ đề này tôi dừng ở đây. Thế là quá đủ. Thây kệ.

CHAOQUAY · 16/4/22

HieuCD đã viết:
Quick Sort tốc độ nhanh nhưng thuật toán khá phức tạp không dành cho người mới tập viết code, người tập viết code ban đầu chỉ cần viết chạy đúng khi trình độ nâng cao mới có khả năng tinh chỉnh rút gọn hoặc tăng tốc xử lý
Tìm trên Google có hàng loạt code của Tây na ná nhau, mượn ý tưởng và thêm vài lệnh tạo "code mới" góp vui với diễn đàn

Mã:

Sub QuickSort(arr, ByVal fRow As Long, ByVal eRow As Long, Optional ByVal a_z As Boolean = True) 'Sort mang 1 chieu "arr" 'fRow, eRow là thu tu dong Dau và dòng Cuoi cua mang "arr" duoc sort, cac dong nam ngoai khoang nay giu nguyen 'Mac dinh a_z = True la Sort A -> Z, neu a_z = False la Sort Z -> A Dim pVal, tVal, fR&, eR&, i& fR = fRow: eR = eRow pVal = arr(fRow) Do While fR <= eR If a_z Then Do While (arr(fR) < pVal) fR = fR + 1 Loop Do While (pVal < arr(eR)) eR = eR - 1 Loop Else Do While (arr(fR) > pVal) fR = fR + 1 Loop Do While (pVal > arr(eR)) eR = eR - 1 Loop End If If (fR <= eR) Then If (arr(fR) > arr(eR)) = a_z Then tVal = arr(fR) arr(fR) = arr(eR) arr(eR) = tVal End If fR = fR + 1 eR = eR - 1 End If Loop If (fRow < eR) Then Call QuickSort(arr, fRow, eR, a_z) If (fR < eRow) Then Call QuickSort(arr, fR, eRow, a_z) End Sub

Chạy sub Main minh họa cách dùng sub "QuickSort"

Mã:

Sub Main() Dim arr, sArr, sRow&, i&, tg#, a_z As Boolean, n& sRow = 10000 'So dong du lieu a_z = True 'Sort tu A toi Z ReDim arr(1 To sRow) ReDim sArr(1 To sRow, 1 To 1) For i = 1 To sRow 'Tao du lieu ngau nhien arr(i) = Int(Rnd() * 10 + 1) sArr(i, 1) = arr(i) Next i Range("A1").Resize(sRow).Value = sArr 'Gan du lieu ngau nhien len Sheet Call QuickSort(arr, 1, sRow, a_z) 'Sort mang arr For i = 1 To sRow 'Gan ket qua Sort sArr(i, 1) = arr(i) Next i Range("B1").Resize(sRow).Value = sArr End Sub

Code QuickSort có thể dùng làm nền để sort mảng 2 chiều với số cột điều kiện là 1, 2 ... n cột, và sort cho cả tiếng việt có dấu

Thứ tự ưu tiên khi sort tiếng Việt có dấu là thế nào vậy bác

HieuCD · 16/4/22

CHAOQUAY đã viết:
Thứ tự ưu tiên khi sort tiếng Việt có dấu là thế nào vậy bác

Mình theo thứ tự của ngài Bill: a, á, à, ã, ả, ạ

CHAOQUAY · 16/4/22

HieuCD đã viết:
Mình theo thứ tự của ngài Bill: a, á, à, ã, ả, ạ

Mảng ban đầu:

a

à

á

ạ

ả

ã

o

ò

ó

ọ

ỏ

õ

Sort theo code:

a

o

à

á

ã

ò

ó

õ

ạ

ả

ọ

ỏ

Sort theo excel:

a

á

à

ã

ả

ạ

o

ó

ò

õ

ỏ

ọ

Thứ tự kết quả bị đứt gãy.
Thực tế sử dụng có lẽ là sort theo excel hợp lý hơn. Dù sao thì có vấn đề gì thì là tại Bill không tại ta

Nhờ các anh chị khắc phục giúp em lỗi "Subscript out of range"

Tất cả chỉ là đưa ra quyết định đúng đắn

File đính kèm

Chỉ biết ngồi BÈ và PHÁN chuyện!!!

Thành viên gắn bó

Thành viên gạo cội

Tất cả chỉ là đưa ra quyết định đúng đắn

Tất cả chỉ là đưa ra quyết định đúng đắn

File đính kèm

Thành viên gạo cội

Thành viên gạo cội

Tất cả chỉ là đưa ra quyết định đúng đắn

File đính kèm

Thành viên gạo cội

Tất cả chỉ là đưa ra quyết định đúng đắn

Chuyên gia GPE

File đính kèm

Thành viên gạo cội

Thành viên gạo cội

Tất cả chỉ là đưa ra quyết định đúng đắn

Chuyên gia GPE

Thành viên gạo cội

File đính kèm

Thành viên gắn bó

Chuyên gia GPE

Thành viên gắn bó