Cần công thức tính một dạng Tổ hợp

[ThuNghi]

Đương nhiên là sai rồi ---> Đầu tiên phải lấy ngẫu nhiên không trùng cho vào 1 biến array trước, xong mới for.. next theo biến array này
Tuy nhiên, nếu là tôi thì tôi sẽ sửa lại 1 chút cho phù hợp với CSDL trên Excel (mảng 2 chiều)

Function Draw(Arr, Amount As Long)
  Dim index As Long, k As Long, d As Long, c As Long, tmpArr, original
  If Amount > UBound(Arr) - LBound(Arr) + 1 Then Exit Function
  original = Arr
  ReDim tmpArr(1 To Amount, 1 To 1)
  d = LBound(original)
  c = UBound(original)
  Randomize
  For k = 1 To Amount
    index = Int(Rnd() * (c - d - k + 2)) + d + k - 1
    tmpArr(k, 1) = original(index)
    original(index) = original(k + LBound(original) - 1)
    d = d + 1
  Next k
  Draw = tmpArr
End Function

Sub Test1()
  Dim sArr(), Amount As Long, rArr
  sArr = Array(1, 2, 3, 4, 5, 9)
  Amount = 3
  rArr = Draw(sArr, Amount)
  Range("B1").Resize(Amount).Value = rArr
End Sub

------------------

Là vầy sư phụ à:
- Ta có mảng Arr
- Duyệt từ 1 đến Amount
- Dùng Rnd để tính vị trí k
- Lấy phần từ thứ k của Arr cho vào mảng khác
- Lấy phần từ thứ nhất của Arr thế vào phần tử thứ k
===> Đó là lần quét đầu tiên
- Đến lần quét thứ 2 sẽ lấy phần tử thứ hai của Ar thế vào phần tử thứ k
vân vân...
Và chắc chắn 100% sẽ không có chuyện trùng, ngoại trừ trường hợp mảng Arr có trùng

Sao tôi thay thử amount=4 thì báo lỗi. <4 thi OK

tmpArr(k, 1) = original(index)

 

[ptm0412]

Thí dụ Arr = (1, 2, 3, 4, 5, 6)

k= 1, index = 2, tmp(1) = 2
original trở thành: (1, 1, 3 ,4, 5, 6)

k = 2, index = 1, tmp(2) = 1
original trở thành (1, 1, 3 ,4, 5, 6) (không đổi vì thay 1 = 1)

k = 3, index = 2 tmp(3) = 1

qua 3 vòng lặp đã có 2 giá trị trùng.

 

[ndu96081631]

Sao tôi thay thử amount=4 thì báo lỗi. <4 thi OK

Dùng code đầu tiên của siwtom đi! Tôi cảm thấy không mấy tin tưởng về code sửa lại sau đó

Function Draw(Arr, Amount As Long)
  Dim index As Long, k As Long, d As Long, c As Long, tmpArr, original
  If Amount > UBound(Arr) - LBound(Arr) + 1 Then Exit Function
  original = Arr
  ReDim tmpArr(1 To Amount, 1 To 1)
  d = LBound(original)
  c = UBound(original)
  Randomize
  For k = 1 To Amount
    index = Int(Rnd() * (c - d + 1)) + d
    tmpArr(k, 1) = original(index)
    original(index) = original(k + LBound(original) - 1)
    d = d + 1
  Next k
  Draw = tmpArr
End Function

 

[ThuNghi]

Thí dụ Arr = (1, 2, 3, 4, 5, 6)

k= 1, index = 2, tmp(1) = 2
original trở thành: (1, 1, 3 ,4, 5, 6)

k = 2, index = 1, tmp(2) = 1
original trở thành (1, 1, 3 ,4, 5, 6) (không đổi vì thay 1 = 1)

k = 3, index = 2 tmp(3) = 1

qua 3 vòng lặp đã có 2 giá trị trùng.

Nhưng nếu e bỏ d=d+1 thì OK với cả 2 code.

 

[ndu96081631]

Thí dụ Arr = (1, 2, 3, 4, 5, 6)

k= 1, index = 2, tmp(1) = 2
original trở thành: (1, 1, 3 ,4, 5, 6)

k = 2, index = 1, tmp(2) = 1
original trở thành (1, 1, 3 ,4, 5, 6) (không đổi vì thay 1 = 1)

k = 3, index = 2 tmp(3) = 1

qua 3 vòng lặp đã có 2 giá trị trùng.

Không thể nào sư phụ à! Vì cái này:

index = Int(Rnd() * (c - d + 1)) + d
....................
d = d + 1

Nên index của lần lập thứ 2 không thể = 1 được (số ngẫu nhiên từ 2 trở đi mà)

 

[ptm0412]

Cũng thí dụ trên:
Khi k = 2, Nếu Rnd chỉ lấy từ phần tử thứ 2 trở về sau: có thể lấy 1 trong các số đen (1, 1, 3 ,4, 5, 6)
Khi k =3, nếu Rnd chỉ lấy từ phần tử thứ 3 trở về sau, thì không lấy 1 đỏ được. Chỉ có thể lấy các số đen: Arr(1, 1, 3 ,4, 5, 6)

 

[ptm0412]

À, thấy rồi, thấy d = d + 1

Do dùng

 chứ không dùng [php] nên dòng lệnh thực và dòng ghi chú cùng màu,  lẫn vào nhau. Xin lỗi nhé.

 

[ThuNghi]

À, thấy rồi, thấy d = d + 1

Do dùng

 chứ không dùng [php] nên dòng lệnh thực và dòng ghi chú cùng màu,  lẫn vào nhau. Xin lỗi nhé.[/QUOTE]
[PHP]Function Draw(Arr, Amount As Long)
Dim index As Long, k As Long, d As Long, c As Long, tmpArr, original
    If Amount > UBound(Arr) - LBound(Arr) + 1 Then Exit Function
    original = Arr
    ReDim tmpArr(1 To Amount)
    d = LBound(original)
    c = UBound(original)
    Randomize
    For k = 1 To Amount
        index = Int(Rnd() * (c - d - k + 2)) + d + k - 1
        tmpArr(k) = original(index)
        original(index) = original(k + LBound(original) - 1)
        d = d + 1
    Next k
    Draw = tmpArr
End Function
[/PHP]
[PHP]Sub Test1()
Dim sArr(), tArr(), i&, iSo&
sArr = Array(1, 2, 3, 4, 5, 9)
iSo = 4
tArr = Draw(sArr, iSo)
For i = 1 To iSo
  Cells(i, 2) = tArr(i)
Next i
End Sub[/PHP]
Vậy thêm dòng
[PHP]If index > c Then index = c[/PHP]
Thì OK. Code của NDU cũng vậy.

 

[vodoi2x]

Code của Siwton nếu để
d=d+1 thì vẫn báo lỗi khi iSo =4 nhưng nếu bỏ d=d+1 thì OK
Code của NDU cũng thế.
Sorry, nhưng bỏ thì sẽ có trùng.

bạn phải lấy post gốc của siwtom ở bài #8 hoặc như của Ndu... ở bài #25

chú ý câu lệnh này
index = Int(Rnd() * (c - d + 1)) + d ''KHÔNG CÓ k trong đó
.........
d=d+1 ''thì cần cái này


--------------
trường hợp có k trong nó (câu lệnh tính index trên) như bài #10 siwtom thì khi đó xóa d=d+1 (nhưng siwtom đã nói không nên dùng cách này)