Trộn số ngẩu nhiên (1 người xem)

Liên hệ QC

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

thangteotdtt

Thành viên hoạt động
Tham gia
12/12/13
Bài viết
152
Được thích
42
Em có các số từ 1 đến 25, khi mình bấm nút thì các số trộn ngẩu nhiên
 

File đính kèm

Bạn có thể gữi file cho mình được không. Cảm ơn
 
Upvote 0
Bạn tham khảo File đính kèm. Nếu không được nữa thì bạn nhờ các anh chị rành VBA giúp.
Thân.
 

File đính kèm

Upvote 0
Công thức trên mình nhầm tí xíu.
PHP:
=INDEX(F$7:F$31,RANDBETWEEN(1,25))

Công thức chỉ có thể chọn số ngẫu nhiên chứ không thể trộn số. Bài toán trộn số có nghĩa là bốc ra các số từ n1 đến n2, mỗi số chỉ được 1 lần.

Giải thuật: (trộn các số từ N1 đến N2)

1. Tạo mảng Mang(N1 to N2) - đối với VBA, khi tạo mảng thì các phần tử có trị là 0
2. bốc randbetween N1-N2
3. Cứ ra 1 số Ni thì ghi lại và đánh dấu Mang(Ni) = 1; tức là đánh dấu số đã dùng

4. Nếu gặp số đã dùng thì có 2 giải thuật:
(i) Đơn giản là bốc lại
(ii) Hơi rắc rối hơn, lấy số kế tiếp, Ni+1 hoặc Ni-1. Nếu số lẻ thì lấy Ni+1, số chẵn thì Ni-1
 
Upvote 0
Bạn mở file trộn số 1, xem được chưa nhé
Chúc thành công
file kèm theo
 

File đính kèm

Upvote 0
macro này sẽ trộn 25 số đang ở cột B, hiện KQ ở cột F

Hai cột số này đều bắt đầu từ dòng 5 (như trong file của bạn Trần Mùi:

PHP:
Option Explicit
Sub Tron25So()
 Dim J As Long, Tmp As Byte
 Dim StrC As String
 
 For J = 5 To 29
    StrC = StrC & Right("0" & CStr(Cells(J, "B")), 2)
 Next J
 For J = 1 To 999
    Randomize
    Tmp = 9 + 9 * Rnd() \ 1
    If Tmp Mod 2 = 0 Then Tmp = Tmp + 1
    If J Mod 2 = 0 Then
        StrC = Mid(StrC, Tmp, 10) & Left(StrC, Tmp - 1) & Mid(StrC, Tmp + 10, 50)
    Else
        StrC = Mid(StrC, Tmp + 10, 50) & Left(StrC, Tmp - 1) & Mid(StrC, Tmp, 10)
    End If
 Next J
 For J = 5 To 29
    Cells(J, "F").Value = Mid(StrC, J * 2 - 9, 2)
 Next J
End Sub

Macro theo giải thuật:
Biến thành chuỗi;
Cắt dán tại những vị trí ngẫu nhiên
Thể hiện kết quả lên trang tính

(Xin cảm ơn Trần Mùi vì file)
 
Lần chỉnh sửa cuối:
Upvote 0
Hai cột số này đều bắt đầu từ dòng 5 (như trong file của bạn Trần Mùi:

PHP:
Option Explicit
Sub Tron25So()
 Dim J As Long, Tmp As Byte
 Dim StrC As String
 
 For J = 5 To 29
    StrC = StrC & Right("0" & CStr(Cells(J, "B")), 2)
 Next J
 For J = 1 To 999
    Randomize
    Tmp = 9 + 9 * Rnd() \ 1
    If Tmp Mod 2 = 0 Then Tmp = Tmp + 1
    If J Mod 2 = 0 Then
        StrC = Mid(StrC, Tmp, 10) & Left(StrC, Tmp - 1) & Mid(StrC, Tmp + 10, 50)
    Else
        StrC = Mid(StrC, Tmp + 10, 50) & Left(StrC, Tmp - 1) & Mid(StrC, Tmp, 10)
    End If
 Next J
 For J = 5 To 29
    Cells(J, "F").Value = Mid(StrC, J * 2 - 9, 2)
 Next J
End Sub

Macro theo giải thuật:
Biến thành chuỗi;
Cắt dán tại những vị trí ngẫu nhiên
Thể hiện kết quả lên trang tính

(Xin cảm ơn Trần Mùi vì file)

Giải thuật:

Dữ liệu ở đây là các số liên tiếp, dùng mảng số là cách trức tiếp và đơn giản.
Chuỗi là giải thuật giành cho trường hợp các trị không phải là số hoặc không phải là số liên tiếp.

Kỹ thuật (code):

1. Lệnh randomize chỉ cần gọi 1 lần. Đặt trong vòng lặp tuy không làm sai kết quả nhưng đó là phương pháp sai. (*)
2. Với kỹ thuật hoán đổi vị trí ký tự chuỗi thì dùng hàm MID để truy vấn nơi cần hoán vị sẽ hiệu quả hơn phương pháp cắt và nối chuõi. (**)
3. Muốn biết một số có phải là số chẵn thì AND nó cho 1. Hiệu quả hơn hàm Mod nhiều. (***)

(*) Lệnh Randomize bảo tiện nghi lấy số random tạo một hạt nhân mới cho hàm Rnd(). Thứ nhất: theo lý thuyết random thì hàm Rnd() dùng trị chuỗi số Taylor để lấy số ngẫu nhiên. Chuỗi Taylor thì cần một hạt nhân. Theo quy ước thì tất cả các hệ thống đều có một hạt nhân mặc định cho chuỗi này. Vì vậy Rnd() luôn luôn đưa ra một dãy số nhất định. Trong nghề gọi cái này là dãy random giả (pseudorandom). Để lấy ngẫu nhiên thực sự, ngôn ngữ lập trình đưa ra lệnh Randomize. Lệnh Randomize buộc hệ thống phải đặt hạt nhân mới cho chương trình. Chỉ cần một hạt nhân mới thì tất cả các dãy random về sau đều ngẫu nhiên. Thứ hai: thường thường thì hạt nhân mới này lấy từ giờ hệ thống. Nếu chương trình chạy nhanh thì giờ hệ thống chưa kịp đổi. Gọi lại randomize thực ra có khả năng đưa hạt nhân cũ vào và sẽ làm lặp lại con số Rnd().

(**) Mỗi lần cắt nối thì hệ thống phải bỏ chuỗi cũ và tạo chuỗi mới. Vì vậy VBA đưa ra hàm MID là hàm đặc biệt có thể dùng để ghi thẳng vào chuõi cũ. Kỹ thuật này tôi đã đề cập nhiều lần rồi.

(**) Lệnh AND trong VBA là lệnh AND bằng bit. Nếu một số lẻ thì nó có cái bit số 1, số chẵn thì không có. Vì vậy để xem một số co phải chắn lẻ thì ta chỉ cần:
IF so AND 1 Then
là số lẻ
ELSE
lè số chẵn
END IF
Trong khi đó lệnh MOD là con toán tính mô đu lô, khá dài.
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn thử code sau
Mã:
Sub Rand()
Dim i As Integer
For i = 1 To 25
    Do: Cells(i, "A") = Int(1 + 25 * Rnd)
    Loop Until WorksheetFunction.CountIf(Range("A1").Resize(i), Cells(i, "A")) = 1
Next
End Sub

1. Rnd mà không có Randomize thì là ngẫu nhiên giả (pseudorandom). Tôi đã giải thích ở bài trước.
Bạn thử chạy code. Copy dữ liệu sang cột khác. Đóng file lại. Mở ra và chạy lại. Sẽ thấy kết quả in hệt như cũ.
Ngẫu nhiên giả giành cho giới khoa học người ta làm thí nghiệm. Bởi vì làm thí nghiệm thì phải có tính chất lập lại được. Có những thí nghiệm mà người ta cần input in hệt nhau cho mỗi lần thử.

2. Lưu ý là trên thực tế, giải thuật "đụng hàng thì gieo lại số khác" có thể áp dụng được nhưng theo thuần lý thuyết thì một ngày đẹp trời nào đó code có thể chạy hoài không dứt vì "đụng hàng" hoài.
 
Upvote 0
Rảnh không có chuyện gì làm. Triển khai thử đôi giải pháp cho bài toán này.

Có hai giải pháp giản dị để trộn một mảng theo thứ tự ngẫu nhiên. Cách sort song song với mảng ngẫu nhiên, và cách hoán vị với phần tử chọn ngẫu nhiên.

Mã:
Sub t()
[COLOR=#008000]' to test the two subs TronMang_1/2
[/COLOR]Const NUMEL = 25 ' number of elements to shuffle
Const NUMTOP = NUMEL - 1 ' use this, since our arrays are base 0

Dim rg As Range
Dim tst() As Variant
ReDim tst(0 To NUMTOP)
Dim i As Integer
Set rg = Cells(1, 1)

For i = 0 To NUMTOP ' đặt dữ liệu để test
    rg.Offset(i, 0) = i + 1 [COLOR=#008000]' muốn test dữ liệu ký tự thì thay i + 1 bằng Chr(65+i)[/COLOR]
Next i

For i = 0 To NUMTOP
    tst(i) = rg.Offset(i, 0)
Next i
TronMang_1 tst[COLOR=#008000] ' test hàm trộn mảng thứ nhất[/COLOR]
For i = 0 To NUMTOP
    rg.Offset(i, 1) = tst(i)
Next i

For i = 0 To NUMTOP
    tst(i) = rg.Offset(i, 0)
Next i
TronMang_2 tst [COLOR=#008000]' test hàm trộn mảng thứ hai[/COLOR]
For i = 0 To NUMTOP
    rg.Offset(i, 2) = tst(i)
Next i

End Sub
'
Sub HoanTri(ByRef a As Variant, ByRef b As Variant)
[COLOR=#008000]' swaps values between a and b
' essential for the two subs TronMang below
[/COLOR]Dim c As Variant
c = a: a = b: b = c
End Sub
'
Sub TronMang_1(ByRef mg As Variant)
[COLOR=#008000]' this sub reorders the array mg in a random order
' it uses the corresponding array method,
' which creates an array of randomly generated numbers
' then sort both arrays in the genarated values order
[/COLOR]Dim lb As Integer, ub As Integer ' lowerbound and upperbound of array
Dim el As Integer ' array element counter
lb = LBound(mg)
ub = UBound(mg)
Dim tron() As Single ' array to help shuffle results
ReDim tron(lb To ub)
Randomize ' seed the random engine
For el = lb To ub
tron(el) = Rnd()
Next el
Dim el2 As Integer ' array element to help sort routine
For el = lb To ub ' bubble sort the arrays
    For el2 = el To ub
        If tron(el2) < tron(el) Then
            HoanTri tron(el2), tron(el)
            HoanTri mg(el2), mg(el)
        End If
    Next el2
Next el
End Sub
'
Sub TronMang_2(ByRef mg As Variant)
[COLOR=#008000]' this sub reorders the array mg in a random order
' it uses the random swap method,
' which goes backward from the last element
' and swap it with a random element within the rest of the array
[/COLOR]Dim lb As Integer ' lowerbound of array
Dim el As Integer ' array element counter
Dim el2 As Integer ' array element to swap
lb = LBound(mg)
Randomize ' seed the random engine
For el = UBound(mg) To lb + 1 Step -1
    ' Pick a random element from index=lb to el
    el2 = Int((el - lb) * Rnd + lb)
    ' Swap this element with the last element
    HoanTri mg(el2), mg(el)
Next el
End Sub
 
Upvote 0
Vd như muốn đánh số CMND trong bang nay k bi trùng thì làm tn bạn

Cảnh cáo:
Với cùng 1 câu hỏi như trên nhưng bạn đã chen ngang vào rất nhiều bài viết (tôi đã xóa bớt)
Cẩn thận! Nếu bạn còn làm thêm lần nữa thì sẽ xử lý kỹ luật
Hãy đọc nội quy diễn đàn trước khi đăng bài
 
Upvote 0
Xin chào

Em can tron cac so 0,1,2,3,4,5,6,7,8,9 de đuoc cac so co 4 chu so.
Nho cac anh chi giup gium em a.
 
Upvote 0
Em không biết dùng cách này như thế nào, anh có thể chỉ cụ thể hơn được không ạ.
 
Upvote 0
ví dụ

tổ hợp

Mã:
dim a,b,c,d as integer
dim ket_qua as string

for a=0 to 9
     for b=0 to 9
          for c=0 to 9
               for d=0 to 9
                    
                       ket_qua=a & b & c & d

               next d
          next c
     next b
next a

tổ hợp không lặp !

Mã:
dim a,b,c,d as integer
dim ket_qua as string

for a=0 to 9
     for b=0 to 9
          for c=0 to 9
               for d=0 to 9
                     
                     if a<>b and a<>c and a<>d then 
                          if b<>a and b<>c and b<>d then 
                               if c<>a and c<>b and c<>d then 
                                      if d<>a and d<>b and d<>c then 
                                           ket_qua=a & b & c & d
                                      end if
                               end if
                          end if
                     end if

               next d
          next c
     next b
next a

chỉnh hợp

Mã:
dim a,b,c,d as integer
dim ket_qua as string

for a=0 to 6
     for b=a+1 to 7
          for c=b+1 to 8
               for d=c+1 to 9
                    
                       ket_qua=a & b & c & d

               next d
          next c
     next b
next a
đại khái vậy đó !
 
Lần chỉnh sửa cuối:
Upvote 0
Em không biết dùng cách này như thế nào, anh có thể chỉ cụ thể hơn được không ạ.

cái này không khó như bạn nghĩ đâu , tôi chỉ cho làm
gõ A1 = 1000
A2 = 1001

bôi đen 2 ô A1 và A2 rồi kéo xuống mệt nghỉ
đến khi nào thấy số 9999 rồi ngưng
đó là tất cả các số bạn cần
 
Upvote 0
Web KT

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

Back
Top Bottom