hiénlinh197
Thành viên tiêu biểu
- Tham gia
- 26/5/09
- Bài viết
- 491
- Được thích
- 113
Bạn chạy thử Sub này:Nhờ các bạn viết giúp code như file đính kèm
Xin cảm ơn các bạn
Public Sub sGpe()
Dim I As Long, J As Long, N As Long, X As Long
With CreateObject("Scripting.Dictionary")
For J = 2 To 16 Step 7
ReDim Arr(1 To 10, 1 To 6)
For I = 1 To 10
.RemoveAll
For N = 1 To 6
Do
X = Int(Rnd() * 9 + 1)
If Not .Exists(X) Then
.Item(X) = ""
Arr(I, N) = X
Exit Do
End If
Loop
Next N
Next I
Cells(4, J).Resize(10, 6) = Arr
Next J
End With
End Sub
Cảm ơn bạn @Ba Tê code chạy được rồiBạn chạy thử Sub này:
PHP:Public Sub sGpe() Dim I As Long, J As Long, N As Long, X As Long With CreateObject("Scripting.Dictionary") For J = 2 To 16 Step 7 ReDim Arr(1 To 10, 1 To 6) For I = 1 To 10 .RemoveAll For N = 1 To 6 Do X = Int(Rnd() * 9 + 1) If Not .Exists(X) Then .Item(X) = "" Arr(I, N) = X Exit Do End If Loop Next N Next I Cells(4, J).Resize(10, 6) = Arr Next J End With End Sub
Bạn @Ba Tê sửa giúp mình là các số tự nhiên từ (0-9)Bạn chạy thử Sub này:
PHP:Public Sub sGpe() Dim I As Long, J As Long, N As Long, X As Long With CreateObject("Scripting.Dictionary") For J = 2 To 16 Step 7 ReDim Arr(1 To 10, 1 To 6) For I = 1 To 10 .RemoveAll For N = 1 To 6 Do X = Int(Rnd() * 9 + 1) If Not .Exists(X) Then .Item(X) = "" Arr(I, N) = X Exit Do End If Loop Next N Next I Cells(4, J).Resize(10, 6) = Arr Next J End With End Sub
Vâng đúng rồi bạn. nếu sửa như bạn @snow25 thì lại mất số 9Sửa vậy, mất số 9.
Cảm ơn bạn @phuocam được rồi bạnSửa vậy:
X = Int(Rnd() * 10)
Đúng rồi bạn @phuocam , mình sửa toàn bị treo máyKhông sửa được, có 6 cột nhưng điền vào 4 số không trùng, kết quả là treo máy luôn!
Hình như bạn viết thiếu con số 1 (-> 14)Mình hỏi thêm là nếu lấy từ (0 đến 4) thì sửa chỗ nào
À mình bớt số cột đi bạn @SA_DQ thì mới chạy đượcHình như bạn viết thiếu con số 1 (-> 14)
Chứ như bạn viết thì lấy đâu cho đủ kí số cho 1 hàng gồm 6 cột?
1. Code không sử dụng Randomize, nó sẽ dùng ngẫu nhiên định chế (pseudo-random). Tức là mõi lần cvhayj, ra kết quả in hệt nhau.Bạn chạy thử Sub này:
PHP:Public Sub sGpe() Dim I As Long, J As Long, N As Long, X As Long With CreateObject("Scripting.Dictionary") For J = 2 To 16 Step 7 ReDim Arr(1 To 10, 1 To 6) For I = 1 To 10 .RemoveAll For N = 1 To 6 Do X = Int(Rnd() * 9 + 1) If Not .Exists(X) Then .Item(X) = "" Arr(I, N) = X Exit Do End If Loop Next N Next I Cells(4, J).Resize(10, 6) = Arr Next J End With End Sub
Trong VBA, bạn nên làm quen với hàm Fix. Hàm này dùng để cắt bỏ số lẻ an toàn hơn Int.Sửa vậy:
X = Int(Rnd() * 10)
Nhờ bạn @VetMini viết thành code dùng mình nhé1. Code không sử dụng Randomize, nó sẽ dùng ngẫu nhiên định chế (pseudo-random). Tức là mõi lần cvhayj, ra kết quả in hệt nhau.
2. Chỉ có mấy số quèn, bạn dùng Array hiệu quả hơn.
Dim D(0 To 9) As Boolean
...
For I = 1 To 10
Erase D
...
If Not D(X) Then
D(X) = True
...
Dictionary tuy rất mạnh nhưng nó vẫn phải hash cái key và tra/ghi bảng. Array dùng chỉ số trực tiếp.
Trong VBA, bạn nên làm quen với hàm Fix. Hàm này dùng để cắt bỏ số lẻ an toàn hơn Int.
Đây bạn xem.Code của bác @VetMiniNhờ bạn @VetMini viết thành code dùng mình nhé
xin cảm ơn!
Public Sub sGpe()
Dim I As Long, J As Long, N As Long, X As Long, D(0 To 9) As Boolean
For J = 2 To 16 Step 7
ReDim arr(1 To 10, 1 To 6)
For I = 1 To 10
Erase D
For N = 1 To 6
Do
X = Int(Rnd() * 10)
If D(X) = False Then
D(X) = True
arr(I, N) = X
Exit Do
End If
Loop
Next N
Next I
Cells(4, J).Resize(10, 6) = arr
Next J
End Sub
Tam sao thất bổn rồi.Đây bạn xem.Code của bác @VetMini
Mã:Public Sub sGpe() Dim I As Long, J As Long, N As Long, X As Long, D(0 To 9) As Boolean For J = 2 To 16 Step 7 ReDim arr(1 To 10, 1 To 6) For I = 1 To 10 Erase D For N = 1 To 6 Do X = Int(Rnd() * 10) If D(X) = False Then D(X) = True arr(I, N) = X Exit Do End If Loop Next N Next I Cells(4, J).Resize(10, 6) = arr Next J End Sub
Anh @VetMini viết luôn giúp em điTam sao thất bổn rồi.
#Const DEBUGMODE = True
Public Sub sGpe()
#If Not DEBUGMODE Then
Randomize
#End If
...
X = FIX(Rnd() * 10)
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2