Sắp xếp dữ liệu ngẫu nhiên - Không trùng dữ liệu

[thanh tong]

Mình nhờ các bạn giúp hộ trường hợp sau:
Mình có một cột dữ liệu mình muốn được sắp sắp xếp nó ngẫu nhiên có điều kiện là không được trùng trong một hàng như file đính kèm
Mục đích là mình muốn làm lịch trực ca thôi
à mà có một nút lệnh để mỗi lần ấn nút thì nó lại có kết quả khác
Cảm ơn các bạn của tôi.

 

[SA_DQ]

Bạn vui lòng thử với macro sự kiện với 1 số đủ lớn nhập vô [H1]:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim StrC As String, Jj As Byte, SoLan As Byte, VTr As Byte
 
 If Not Intersect(Target, [h1]) Is Nothing Then
   For Jj = 2 To 7
      If Jj Mod 2 = 1 Then
         StrC = Cells(Jj, "B").Value & StrC
      Else
         StrC = StrC & Cells(Jj, "B").Value
      End If
   Next Jj
   If [h1].Value < 10 Then SoLan = 10 * [h1].Value + 9
   If [h1].Value > 99 Then SoLan = [h1].Value Mod 99 + 9
   For Jj = 0 To SoLan
      Randomize
      VTr = 1 + Int(5 * Rnd())
      StrC = Mid(StrC, VTr, 7) & Left(StrC, VTr - 1)
   Next Jj
   For Jj = 3 To 8
      Cells(2, Jj).Value = Mid(StrC, Jj - 2, 1)
   Next Jj
 End If
End Sub

 

[ndu96081631]

Mình nhờ các bạn giúp hộ trường hợp sau:
Mình có một cột dữ liệu mình muốn được sắp sắp xếp nó ngẫu nhiên có điều kiện là không được trùng trong một hàng như file đính kèm
Mục đích là mình muốn làm lịch trực ca thôi
à mà có một nút lệnh để mỗi lần ấn nút thì nó lại có kết quả khác
Cảm ơn các bạn của tôi.

Bạn xem bài này:
http://www.giaiphapexcel.com/forum/showthread.php?27286-T%E1%BA%A1o-d%C3%A3y-s%E1%BB%91-ng%E1%BA%ABu-nhi%C3%AAn-kh%C3%B4ng-tr%C3%B9ng&
Hàm cực ngắn
Áp dụng vào bài của bạn, ta sửa code lại 1 tí thành:

Function UniqueRandomNum(Bottom As Long, Top As Long, Amount As Long)
  'Application.Volatile '<--- Neu muon gia tri thay doi khi bam F9
  On Error Resume Next
  If Amount > Top - Bottom + 1 Then Amount = Top - Bottom + 1
  With CreateObject("Scripting.Dictionary")
    Do
      .Add Int(Rnd() * (Top - Bottom + 1)) + Bottom, ""
    Loop Until .Count = Amount
    UniqueRandomNum = .Keys
  End With
End Function

Quét chọn C2:H2 rồi gõ vào thanh Formula công thức:

=INDEX($B$2:$B$7,UniqueRandomNum(1,6,6))

Bấm tổ hợp phím Ctrl + Shift + Enter
Xong!
-----------------

Bạn vui lòng thử với macro sự kiện với 1 số đủ lớn nhập vô [H1]:

Sư phụ ơi, dùng phép nối chuổi em e rằng không ổn đâu! Với dữ liệu thế này:



Kết quả sai toàn bộ
Nói chung bài toán Unique, bắt buộc phải dùng Dictionary hoặc Collection thì mới CHÍNH XÁC 100%... Còn không thì Excel đã có sẳn Advanced Filter, cứ thế mà xài thôi