Xin VBA lấy số ngẫu nhiên từ 1 danh sách số

Liên hệ QC

ultima_86

Thành viên mới
Tham gia
31/1/09
Bài viết
27
Được thích
1
Chào mọi người, mình có file ví dụ đính kèm và cần thực hiện các thao tác sau:
*** Lấy 10 số ngẫu nhiên (VD là từ 1 đến 100) (xuất ra ở ô A2 tới A11) bằng cách nhấn nút "Button 1" . Sau mỗi lần nhấn, 10 số mới sẽ đè lên 10 số cũ ở ô A2 tới A11. Sau 10 lần nhấn, tất cả các số phải được lấy ra hết và không có trùng lặp.
Mong mọi người giúp đỡ, vì mình không biết gì về VBA cả. Cám ơn mọi người!
 

File đính kèm

  • Sample.xlsx
    12.4 KB · Đọc: 8
Chào mọi người, mình có file ví dụ đính kèm và cần thực hiện các thao tác sau:
*** Lấy 10 số ngẫu nhiên (VD là từ 1 đến 100) (xuất ra ở ô A2 tới A11) bằng cách nhấn nút "Button 1" . Sau mỗi lần nhấn, 10 số mới sẽ đè lên 10 số cũ ở ô A2 tới A11. Sau 10 lần nhấn, tất cả các số phải được lấy ra hết và không có trùng lặp.
Mong mọi người giúp đỡ, vì mình không biết gì về VBA cả. Cám ơn mọi người!
Thử xem ..................................!
 

File đính kèm

  • Sample_Randomize_ultima_86.xlsm
    22.8 KB · Đọc: 4
Upvote 0
Chào mọi người, mình có file ví dụ đính kèm và cần thực hiện các thao tác sau:
*** Lấy 10 số ngẫu nhiên (VD là từ 1 đến 100) (xuất ra ở ô A2 tới A11) bằng cách nhấn nút "Button 1" . Sau mỗi lần nhấn, 10 số mới sẽ đè lên 10 số cũ ở ô A2 tới A11. Sau 10 lần nhấn, tất cả các số phải được lấy ra hết và không có trùng lặp.
Mong mọi người giúp đỡ, vì mình không biết gì về VBA cả. Cám ơn mọi người!
Chạy nhiều lần sub ABC
Mã:
Option Explicit
Dim Arr&(), k&
Sub ABC()
  Dim res&(), i&
  Const N& = 100:  Const sRow& = 10
 
  ReDim res(1 To N, 1 To 1)
  If k = 0 Then Call UniqueRand(N)
  For i = 1 To sRow
    res(i, 1) = Arr(k * sRow + i)
  Next i
  Sheets("Sheet2").Range("A2").Resize(sRow) = res
  Sheets("Sheet2").Range("A1") = "Dot: " & k + 1
  If k = 9 Then
    MsgBox ("Chay Xong " & N & " So")
    k = 0
  Else
    k = k + 1
  End If
End Sub

Private Sub UniqueRand(ByVal N As Long)
  Dim sArr(), i&, RndNum&, tmp&
 
  ReDim Arr(1 To N)
  sArr = Sheets("Sheet2").Range("A2").Resize(N).Value
  Randomize
  For i = 1 To N
    RndNum = Int(N * Rnd() + 1)
    If Arr(RndNum) = 0 Then tmp = RndNum Else tmp = Arr(RndNum)
    If Arr(N) = 0 Then Arr(RndNum) = N Else Arr(RndNum) = Arr(N)
    Arr(N) = tmp
    N = N - 1
  Next i
  For i = 1 To N
    Arr(i) = sArr(Arr(i), 1)
  Next i
End Sub
 

File đính kèm

  • Sample.xlsb
    19.3 KB · Đọc: 8
Upvote 0
Ý tưởng mới đánh Keno hả.

Bài không khó nhưng cái vụ 10 lần nhấn thì phải suy nghĩ cho kỹ rồi hãy yêu cầu.
Điển hình:
1. nếu nhấn lần thứ 11 thì sao?
2. nếu không có cách trở lại lần thứ i-1 thì lý do tại sao các lượt i's phải khác nhau?
3. nếu muốn xoá bài làm lại thì phảin làm sao?

Nhắn các tác giả bài #2 và #3:
Thớt mới chỉ có ý tưởng chứ chưa bao giờ thực hiện cho nên chưa biết hết các chuyện rắc rối phụ đi theo yêu cầu của mình.
 
Upvote 0
Chạy nhiều lần sub ABC
Mã:
Option Explicit
Dim Arr&(), k&
Sub ABC()
  Dim res&(), i&
  Const N& = 100:  Const sRow& = 10
 
  ReDim res(1 To N, 1 To 1)
  If k = 0 Then Call UniqueRand(N)
  For i = 1 To sRow
    res(i, 1) = Arr(k * sRow + i)
  Next i
  Sheets("Sheet2").Range("A2").Resize(sRow) = res
  Sheets("Sheet2").Range("A1") = "Dot: " & k + 1
  If k = 9 Then
    MsgBox ("Chay Xong " & N & " So")
    k = 0
  Else
    k = k + 1
  End If
End Sub

Private Sub UniqueRand(ByVal N As Long)
  Dim sArr(), i&, RndNum&, tmp&
 
  ReDim Arr(1 To N)
  sArr = Sheets("Sheet2").Range("A2").Resize(N).Value
  Randomize
  For i = 1 To N
    RndNum = Int(N * Rnd() + 1)
    If Arr(RndNum) = 0 Then tmp = RndNum Else tmp = Arr(RndNum)
    If Arr(N) = 0 Then Arr(RndNum) = N Else Arr(RndNum) = Arr(N)
    Arr(N) = tmp
    N = N - 1
  Next i
  For i = 1 To N
    Arr(i) = sArr(Arr(i), 1)
  Next i
End Sub
Cám ơn bạn đã giúp, mục đích của mình chỉ để tạo ra 1 file có thể lấy số ngẫu nhiên không trùng lặp với trong khoảng mình mong muốn là đủ (mình thấy yêu cầu của bác Vetmini thì cao quá). Mình dùng thử thấy rất tốt. Nhưng mình có thêm câu hỏi là:
1. Thay vì lấy từ 1 đến 100 (gọi là số thứ tự theo mục đích trong file của mình), thì mình có thể lấy được nhiều hơn không (ví dụ là lấy 173 số)? Mỗi lần vẫn hiển thị ra 10 số.
2. Số thứ tự bắt đầu và số thứ tự kết thúc có thể do mình tự chọn không?
3. Do dữ liệu của mình tăng lên theo ngày nên cái Msg box thực sự không cần (vì mình có ghi chú vào sổ tay). Bạn giúp mình bỏ nó được không?
Vì thực tế dữ liệu số thứ tự của mình mỗi ngày sẽ tăng thêm và sang các ngày hôm sau có nhiều số thứ tự cũ mình ít dùng lại (tuy nhiên vẫn còn phải sử dụng).
Mình xin lỗi vì đã mô tả không kỹ lưỡng phần mục đích của mình.
Bài đã được tự động gộp:

Ý tưởng mới đánh Keno hả.

Bài không khó nhưng cái vụ 10 lần nhấn thì phải suy nghĩ cho kỹ rồi hãy yêu cầu.
Điển hình:
1. nếu nhấn lần thứ 11 thì sao?
2. nếu không có cách trở lại lần thứ i-1 thì lý do tại sao các lượt i's phải khác nhau?
3. nếu muốn xoá bài làm lại thì phảin làm sao?

Nhắn các tác giả bài #2 và #3:
Thớt mới chỉ có ý tưởng chứ chưa bao giờ thực hiện cho nên chưa biết hết các chuyện rắc rối phụ đi theo yêu cầu của mình.
Cám ơn bạn đã nhắc mình. Vì mình không biết VBA nên cũng không đoán được các phát sinh sẽ có, nhưng bài của bạn HieuCD cũng đã gần phù hợp với mục đích của mình rồi.
 
Upvote 0
Cám ơn bạn đã giúp, mục đích của mình chỉ để tạo ra 1 file có thể lấy số ngẫu nhiên không trùng lặp với trong khoảng mình mong muốn là đủ (mình thấy yêu cầu của bác Vetmini thì cao quá). Mình dùng thử thấy rất tốt. Nhưng mình có thêm câu hỏi là:
1. Thay vì lấy từ 1 đến 100 (gọi là số thứ tự theo mục đích trong file của mình), thì mình có thể lấy được nhiều hơn không (ví dụ là lấy 173 số)? Mỗi lần vẫn hiển thị ra 10 số.
2. Số thứ tự bắt đầu và số thứ tự kết thúc có thể do mình tự chọn không?
3. Do dữ liệu của mình tăng lên theo ngày nên cái Msg box thực sự không cần (vì mình có ghi chú vào sổ tay). Bạn giúp mình bỏ nó được không?
Vì thực tế dữ liệu số thứ tự của mình mỗi ngày sẽ tăng thêm và sang các ngày hôm sau có nhiều số thứ tự cũ mình ít dùng lại (tuy nhiên vẫn còn phải sử dụng).
Mình xin lỗi vì đã mô tả không kỹ lưỡng phần mục đích của mình.
Bài đã được tự động gộp:


Cám ơn bạn đã nhắc mình. Vì mình không biết VBA nên cũng không đoán được các phát sinh sẽ có, nhưng bài của bạn HieuCD cũng đã gần phù hợp với mục đích của mình rồi.
Khai báo địa chỉ lấy dữ liệu tại ô A1 của Sheet1
Mã:
Dim Arr&(), k&, DiaChi$

Sub ABC()
  Dim res(), i&, N&, DiaChiMoi$
  Const sRow& = 10 'So dòng ket qua
  
  DiaChiMoi$ = Sheets("Sheet1").Range("A1").Value 'Dia chi du lieu o Sheet1
  If DiaChi <> DiaChiMoi Then k = 0: DiaChi = DiaChiMoi
  If k = 0 Then Call UniqueRand(Sheets("Sheet1").Range(DiaChi).Value)
  
  ReDim res(1 To sRow, 1 To 1)
  For i = 1 To sRow
    k = k + 1
    res(i, 1) = Arr(k)
    If k = UBound(Arr) Then k = 0: Exit For
  Next i
  Sheets("Sheet2").Range("A2").Resize(sRow) = res
End Sub

Private Sub UniqueRand(ByVal sArr As Variant)
  Dim i&, N&, RndNum&, tmp&

  N = UBound(sArr)
  ReDim Arr(1 To N)
  Randomize
  For i = 1 To N
    RndNum = Int(N * Rnd() + 1)
    If Arr(RndNum) = 0 Then tmp = RndNum Else tmp = Arr(RndNum)
    If Arr(N) = 0 Then Arr(RndNum) = N Else Arr(RndNum) = Arr(N)
    Arr(N) = tmp
    N = N - 1
  Next i
  For i = 1 To UBound(Arr)
    Arr(i) = sArr(Arr(i), 1)
  Next i
End Sub
 

File đính kèm

  • Sample.xlsb
    19.9 KB · Đọc: 10
Upvote 0
Cám ơn bạn mình đã thử nhưng chỉ lấy được có 96 số thôi.
Thì tôi bỏ bớt 4 số ở sheet1 rồi. Phải thử giả như không tròn nhóm 10 thì sao chứ
Bài đã được tự động gộp:

Cám ơn bạn đã giúp, mục đích của mình chỉ để tạo ra 1 file có thể lấy số ngẫu nhiên không trùng lặp với trong khoảng mình mong muốn là đủ (mình thấy yêu cầu của bác Vetmini thì cao quá). Mình dùng thử thấy rất tốt. Nhưng mình có thêm câu hỏi là:
1. Thay vì lấy từ 1 đến 100 (gọi là số thứ tự theo mục đích trong file của mình), thì mình có thể lấy được nhiều hơn không (ví dụ là lấy 173 số)? Mỗi lần vẫn hiển thị ra 10 số.
2. Số thứ tự bắt đầu và số thứ tự kết thúc có thể do mình tự chọn không?
3. Do dữ liệu của mình tăng lên theo ngày nên cái Msg box thực sự không cần (vì mình có ghi chú vào sổ tay). Bạn giúp mình bỏ nó được không?
Vì thực tế dữ liệu số thứ tự của mình mỗi ngày sẽ tăng thêm và sang các ngày hôm sau có nhiều số thứ tự cũ mình ít dùng lại (tuy nhiên vẫn còn phải sử dụng).
Mình xin lỗi vì đã mô tả không kỹ lưỡng phần mục đích của mình.
Bài đã được tự động gộp:


Cám ơn bạn đã nhắc mình. Vì mình không biết VBA nên cũng không đoán được các phát sinh sẽ có, nhưng bài của bạn HieuCD cũng đã gần phù hợp với mục đích của mình rồi.
Bài #2 của tôi đã giải quyết được mục 1 và 2 của bạn rồi.
Bài đã được tự động gộp:

Ý tưởng mới đánh Keno hả.

Bài không khó nhưng cái vụ 10 lần nhấn thì phải suy nghĩ cho kỹ rồi hãy yêu cầu.
Điển hình:
1. nếu nhấn lần thứ 11 thì sao?
2. nếu không có cách trở lại lần thứ i-1 thì lý do tại sao các lượt i's phải khác nhau?
3. nếu muốn xoá bài làm lại thì phảin làm sao?

Nhắn các tác giả bài #2 và #3:
Thớt mới chỉ có ý tưởng chứ chưa bao giờ thực hiện cho nên chưa biết hết các chuyện rắc rối phụ đi theo yêu cầu của mình.
Mục đích của tôi là cũng giải trí tí chút. Phát sinh đến đâu thì ta xử đến đó thôi. Với bài #2 thì nhấn lần thứ 10 thì reset lại biến đếm. Lần 11 thì xoá kết quả cũ và làm lại từ đầu.
 
Lần chỉnh sửa cuối:
Upvote 0
Bài này thuộc loại khá dễ. Dễ hơn lấy Random số cho phép trùng.
m*n số, một lần lấy ngẫu nhiên n số, và lấy đủ m lần thì hết. Con toán rất giản dị:
- Lập mảng 2 chiều a(1 to m*n, 1 to 2)
- vòng lặp ghi a(i, 1) = i; a(i, 2) = Rnd()
- Sort theo cột thứ 2
- Bốc ra mỗi lần n phần tử
 
Upvote 0
. . . . các thao tác sau: Lấy 10 số ngẫu nhiên (VD là từ 1 đến 100) (xuất ra ở ô A2 tới A11) bằng cách nhấn nút "Button 1" .
Sau mỗi lần nhấn, 10 số mới sẽ đè lên 10 số cũ ở ô A2 tới A11. Sau 10 lần nhấn, tất cả các số phải được lấy ra hết và không có trùng lặp.
Nếu nhiệm vụ này mình được giao mình sẽ làm như sau:
1./ Khai báo 1 biến để chứa chuỗi
2./ Tạo vòng lặp để ghi các kí tự số này ('001','002,. . . .,'100') vô tham biến vừa khai báo;
3./ Băm thật nhuyễn chuỗi này ra 3 khúc sau mỗi lần & ráp lại không như vừa băm
4./ Cắt 1/10 chuỗi sau mỗi 1 lần 'ấn' nút
 
Upvote 0
Nếu nhiệm vụ này mình được giao mình sẽ làm như sau:
1./ Khai báo 1 biến để chứa chuỗi
2./ Tạo vòng lặp để ghi các kí tự số này ('001','002,. . . .,'100') vô tham biến vừa khai báo;
3./ Băm thật nhuyễn chuỗi này ra 3 khúc sau mỗi lần & ráp lại không như vừa băm
4./ Cắt 1/10 chuỗi sau mỗi 1 lần 'ấn' nút
Chơi kiểu này là kiểu xào bài?
Hiện tại 100 số, chuỗi dài 300 ký tự. Băm đã hơi mệt.
Cỡ 1000 số, chuỗi sẽ dài 4000 ký tự. Máy băm xì khói luôn.
 
Upvote 0
Nếu nhiệm vụ này mình được giao mình sẽ làm như sau:
1./ Khai báo 1 biến để chứa chuỗi
2./ Tạo vòng lặp để ghi các kí tự số này ('001','002,. . . .,'100') vô tham biến vừa khai báo;
3./ Băm thật nhuyễn chuỗi này ra 3 khúc sau mỗi lần & ráp lại không như vừa băm
4./ Cắt 1/10 chuỗi sau mỗi 1 lần 'ấn' nút
Bác Sa hướng dẫn em chỗ này với:
2./ Tạo vòng lặp để ghi các kí tự số này ('001','002,. . . .,'100') vô tham biến vừa khai báo;
3./ Băm thật nhuyễn chuỗi này ra 3 khúc sau mỗi lần & ráp lại không như vừa băm
Thật tình là em chưa hiểu bác làm ra sao
 
Upvote 0
(Khai bao 1 biến chứa trị ngẫu)
Tìm 1 trị ngẫu nhét (từ 13 cho đến 190 nào đó) vô biến với điều kiện công thêm hay bới đi 1 hoặc 2 để rớt vô thứ 10, 13, 16,. . . . trong chuỗi
Cắt thành 3 khúc: Khúc đầu = với số trong ngẫu trong dẩy trên, khúc thứ 2 chỉ có độ dài 21 hay 24 & còn lại là khúc thứ 3
Khi ráp thì khúc đầu vô giữa là được
Xỉn hả; có hộ chiếu vacxin chưa?
 
Lần chỉnh sửa cuối:
Upvote 0
(Khai bao 1 biến chứa trị ngẫu)
Tìm 1 trị ngẫu nhét (từ 13 cho đến 190 nào đó) vô biến với điều kiện công thêm hay bới đi 1 hoặc 2 để rớt vô thứ 10, 13, 16,. . . . trong chuỗi
Cắt thành 3 khúc: Khúc đầu = với số trong ngẫu trong dẩy trên, khúc thứ 2 chỉ có độ dài 21 hay 24 & còn lại là khúc thứ 3
Khi ráp thì khúc đầu vô giữa là được
Xỉn hả; có hộ chiếu vacxin chưa?
1) Hihi,đọc trả lời của bác xong em....hông hiểu, chắc phải có thí dụ
Mà sao khó vậy, nếu là em , em làm vầy
1.1) Lúc biến Dem=0 em cho chạy 1 vòng từ số đầu đến số cuối, tạo mảng ( thí dụ Nguon) số như ý của chủ "thớt"
1.2) Chạy tiếp 1 vòng nữa tạo mảng (thí dụ KetQua) là mảng ngẫu nhiên không trùng ( giá trị các phần tử của mảng Nguon )
1.3) Bi giờ cứ tóm em KetQua làm con tin, muốn lấy bao nhiêu lần, 1 lần bao nhiêu phần tử thì cứ vào mà thịt em KetQua
2) Em mới chơi 1 nhát, được 1 tháng, chờ nửa tháng nữa mới được chơi nhát thứ 2
 
Upvote 0
Khai báo địa chỉ lấy dữ liệu tại ô A1 của Sheet1
Mã:
Dim Arr&(), k&, DiaChi$

Sub ABC()
  Dim res(), i&, N&, DiaChiMoi$
  Const sRow& = 10 'So dòng ket qua
 
  DiaChiMoi$ = Sheets("Sheet1").Range("A1").Value 'Dia chi du lieu o Sheet1
  If DiaChi <> DiaChiMoi Then k = 0: DiaChi = DiaChiMoi
  If k = 0 Then Call UniqueRand(Sheets("Sheet1").Range(DiaChi).Value)
 
  ReDim res(1 To sRow, 1 To 1)
  For i = 1 To sRow
    k = k + 1
    res(i, 1) = Arr(k)
    If k = UBound(Arr) Then k = 0: Exit For
  Next i
  Sheets("Sheet2").Range("A2").Resize(sRow) = res
End Sub

Private Sub UniqueRand(ByVal sArr As Variant)
  Dim i&, N&, RndNum&, tmp&

  N = UBound(sArr)
  ReDim Arr(1 To N)
  Randomize
  For i = 1 To N
    RndNum = Int(N * Rnd() + 1)
    If Arr(RndNum) = 0 Then tmp = RndNum Else tmp = Arr(RndNum)
    If Arr(N) = 0 Then Arr(RndNum) = N Else Arr(RndNum) = Arr(N)
    Arr(N) = tmp
    N = N - 1
  Next i
  For i = 1 To UBound(Arr)
    Arr(i) = sArr(Arr(i), 1)
  Next i
End Sub
Cám ơn bạn, mình đã thử rồi, phù hợp với mục đích của mình. Chúc bạn sức khỏe và thành công trong cuộc sống
 
Upvote 0
Nè, CoGia thí dụ đây:

PHP:
Sub XaoBai()
 Dim J As Integer, Num As Integer
 Dim StrC As String, Tmp As String
 
 Randomize
 For J = 1 To 52    'Nôi    '
    Num = 1 + 13 * Rnd() \ 1
    If J < 10 Then
        Tmp = "0" & CStr(J)
        If Num Mod 2 = 0 Then StrC = StrC & Tmp Else StrC = Tmp & StrC
    Else
        Tmp = CStr(J)
        Select Case Num Mod 3
        Case 0
            StrC = Mid(StrC, 7, Len(StrC)) & Tmp & Left(StrC, 6)
        Case 1
            StrC = Mid(StrC, 9, Len(StrC)) & Left(StrC, 8) & Tmp
        Case 2
            StrC = Left(StrC, 10) & Tmp & Mid(StrC, 11, Len(StrC))
        End Select
    End If
 Next J
 MsgBox StrC
End Sub
 
Upvote 0
Web KT

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

Back
Top Bottom