thangteotdtt
Thành viên hoạt động



- Tham gia
- 12/12/13
- Bài viết
- 152
- Được thích
- 42
Công thức trên mình nhầm tí xíu.
PHP:=INDEX(F$7:F$31,RANDBETWEEN(1,25))
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
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)
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
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
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
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
Vd như muốn đánh số CMND trong bang nay k bi trùng thì làm tn bạn
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.
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
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
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
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 ạ.