Xắp xếp ngẫu nhiên vùng dữ liệu

[anktdn]

Em có file ví dụ nhờ Bác giúp đỡ code cách xắp xếp ngẫu nhiên vùng dữ liệu sau mỗi lần nhấn nút và có thể đúng cho nhiều hàng cùng 1 số.

 

[cadafi]

Em có file ví dụ nhờ Bác giúp đỡ code cách xắp xếp ngẫu nhiên vùng dữ liệu sau mỗi lần nhấn nút và có thể đúng cho nhiều hàng cùng 1 số.

Bạn xem file đính kèm nhé! Mỗi lần Sort sẽ khác nhau! Cột A mình dùng thêm hàm Rand(), sau đó Sort theo cột A là xong!

 

[anktdn]

Ý của em là phải đồng nhất theo vùng của số, vùng số 4 có 3 hàng sẽ vẫn giữ nguyên như vậy, tương tự vùng số 6 có 3 hàng và vẫn nằm liên tiếp nhau như vậy, cho đến hết các dãy số trong vùng; Có thể đúng cho mọi trường hợp nếu tăng thêm trên 3 hàng cùng 1 số, đó là bài toán em cần.thanks

 

[hoangvuluan]

Sắp ngẫu nhiên

Nếu không quá đòi hỏi về tính ngẫu nhiên thì có thể dùng cách hoán chuyển các phần tử trong danh sách. Trong mã đã khai báo sẵn hằng 3 là nhóm bộ 3 các dòng sẽ luôn đi cùng nhau. Phải đảm bảo về yếu tố này để code chạy đúng.

Private Sub CommandButton1_Click()
Const [COLOR=darkred]skip = 3
[/COLOR]Dim ra As Range, sa As Range
Dim va
    On Error Resume Next
    Application.ScreenUpdating = False
    Set ra = Me.Range("data")
    c = ra.Columns.Count
    r = ra.Rows.Count
    Set sa = ra.Offset(0, c + 1) ' doi qua c+1 cot de ghi ket qua
    
    va = ra
    Randomize
    For i = 1 To r - skip Step skip
        k = 3 * Int(1 + Rnd * (r \ skip)) + 1
        For j = 1 To c
            Call swap(va(i, j), va(k, j))
            Call swap(va(i + 1, j), va(k + 1, j))
            Call swap(va(i + 2, j), va(k + 2, j))
        Next
    Next
    sa = va
    sa.Select
    Application.ScreenUpdating = True
End Sub
Private Sub swap(v1, v2)
    t = v1
    v1 = v2
    v2 = t
End Sub

Trên sheet, tôi đặt 1 name: DATA tham chiếu đến vùng dữ liệu sẽ sắp ngẫu nhiên. Nếu muốn thay đổi số cột thì tạo lại name này với số cột mong muốn. Dữ liệu sau khi sắp sẽ đặt phân cách với dữ liệu cũ 1 cột.
name: DATA = OFFSET(Sheet1!$B$2,0,0,COUNTA(Sheet1!$B$2:$B$290),2) ' 2 cột
Xem file đính kèm.

 

[anktdn]

Cảm ơn hoangvuluan đã co code cho file trên nhưng vẫn chưa đúng ý của mình, ý mình sắp xếp ngẫu nhiên nhưng vẫn theo vùng của số đó tức vùng số 3 vẫn giữ nguyên vùng số 3, vùng số 6 vẫn giữa nguyên vùng số 6 tương tự cho các vùng còn lại.
đây là ý của mình
3 AG
3 AT
3 HJ
6 RF
6 JH
6 RG
6 UH
4 KM
4 GB
4 NJ
...

 

[hoangvuluan]

Sắp ngẫu nhiên

Cảm ơn hoangvuluan đã co code cho file trên nhưng vẫn chưa đúng ý của mình, ý mình sắp xếp ngẫu nhiên nhưng vẫn theo vùng của số đó tức vùng số 3 vẫn giữ nguyên vùng số 3, vùng số 6 vẫn giữa nguyên vùng số 6 tương tự cho các vùng còn lại.
đây là ý của mình
3 AG
3 AT
3 HJ
6 RF
6 JH
6 RG
6 UH
4 KM
4 GB
4 NJ
...

Bạn đã kiểm tra lại file mà tôi vừa ReUpLoad chưa? Trong đó đã xử lý sắp theo nhóm rồi mà!

 

[anktdn]

Nếu không quá đòi hỏi về tính ngẫu nhiên thì có thể dùng cách hoán chuyển các phần tử trong danh sách. Trong mã đã khai báo sẵn hằng 3 là nhóm bộ 3 các dòng sẽ luôn đi cùng nhau. Phải đảm bảo về yếu tố này để code chạy đúng.

Private Sub CommandButton1_Click()
Const [COLOR=darkred]skip = 3
[/COLOR]Dim ra As Range, sa As Range
Dim va
    On Error Resume Next
    Application.ScreenUpdating = False
    Set ra = Me.Range("data")
    c = ra.Columns.Count
    r = ra.Rows.Count
    Set sa = ra.Offset(0, c + 1) ' doi qua c+1 cot de ghi ket qua
    
    va = ra
    Randomize
    For i = 1 To r - skip Step skip
        k = 3 * Int(1 + Rnd * (r \ skip)) + 1
        For j = 1 To c
            Call swap(va(i, j), va(k, j))
            Call swap(va(i + 1, j), va(k + 1, j))
            Call swap(va(i + 2, j), va(k + 2, j))
        Next
    Next
    sa = va
    sa.Select
    Application.ScreenUpdating = True
End Sub
Private Sub swap(v1, v2)
    t = v1
    v1 = v2
    v2 = t
End Sub

Trên sheet, tôi đặt 1 name: DATA tham chiếu đến vùng dữ liệu sẽ sắp ngẫu nhiên. Nếu muốn thay đổi số cột thì tạo lại name này với số cột mong muốn. Dữ liệu sau khi sắp sẽ đặt phân cách với dữ liệu cũ 1 cột.
name: DATA = OFFSET(Sheet1!$B$2,0,0,COUNTA(Sheet1!$B$2:$B$290),2) ' 2 cột
Xem file đính kèm.

Cảm ơn hoangvuluan có đáp án. Cho mình hỏi thêm còn nếu dòng không bằng nhau có dòng 3, dòng 4, hoặc hơn thế nữa thì sao, tức không đồng nhất về hàng.

 

[hoangvuluan]

Thì cải tiến giải thuật, dùng 1 vòng lặp để đếm số phần tử trong nhóm và xác định vị trí bắt đầu của mỗi nhóm. Tính ra tổng số các nhóm. Sau đó mới xác định hệ số k ngẫu nhiên để hoán đổi.
Nếu có yêu cầu về vấn đề này thì có thời gian tôi sẽ trình bày tiếp
Thân!

 

[phamduylong]

Cảm ơn hoangvuluan đã co code cho file trên nhưng vẫn chưa đúng ý của mình, ý mình sắp xếp ngẫu nhiên nhưng vẫn theo vùng của số đó tức vùng số 3 vẫn giữ nguyên vùng số 3, vùng số 6 vẫn giữa nguyên vùng số 6 tương tự cho các vùng còn lại.
đây là ý của mình
...

Thủ tục MyRand sẽ sắp xếp sang bên trái 2 cột.
Nếu ô đầu tiên của dữ liệu là B2 thì: rd=2 cd=2. Nếu là ô khác thì chỉnh lại rd (dòng đầu), cd (cột đầu).

Sub MyRand()
Dim r As Long, rd As Long, rc As Long, cd As Long, rRnd As Double, stt As Long, i As Long
Application.ScreenUpdating = False
rd = 2
cd = 2
rc = Cells(rd, cd).End(xlDown).Row
Range(Cells(rd, cd + 2), Cells(rc, cd + 4)).ClearContents
Range(Cells(rd, cd), Cells(rc, cd + 1)).Copy Cells(rd, cd + 2)
stt = Cells(rd, cd)
rRnd = Int(Rnd() * 10 ^ 13) * 10
For r = rd To rc
  If Cells(r, cd) = stt Then
    Cells(r, cd + 4) = rRnd + i
    i = i + 1
  Else
    stt = Cells(r, cd)
    rRnd = Int(Rnd() * 10 ^ 13) * 10
    i = 1
    Cells(r, cd + 4) = rRnd + i
  End If
Next
Range(Cells(rd, cd + 2), Cells(rc, cd + 4)).Sort Key1:=Cells(rd, cd + 4), Order1:=xlAscending, Header:=xlGuess
Range(Cells(rd, cd + 4), Cells(rc, cd + 4)).ClearContents
End Sub