[Giúp đỡ tìm lỗi sai] Tạo dãy ký tự ngẫu nhiên

[tsslump]

Chào các bác

File đính kèm là tôi dùng để tạo 1 dãy ký tự ngẫu nhiên:
. Độ dài ký tự: Tự thiết lập - Đã làm được
. Số lượng dãy ký tự: Tự thiết lập - Đã làm được
. Viết hoa - Đã làm được
. Bao gồm ký tự số(0 - 9) & chữ cái(Không bao gồm chữ O) - Đã làm được
. Không có ký tự đặc biệt - Đã làm được
. Không trùng lặp: Tính nay này tôi chưa làm được. Nhờ các bác giúp đỡ chỉnh lại

Xin đa tạ

 

[Nhattanktnn]

Chào các bác

File đính kèm là tôi dùng để tạo 1 dãy ký tự ngẫu nhiên:
. Độ dài ký tự: Tự thiết lập - Đã làm được
. Số lượng dãy ký tự: Tự thiết lập - Đã làm được
. Viết hoa - Đã làm được
. Bao gồm ký tự số(0 - 9) & chữ cái(Không bao gồm chữ O) - Đã làm được
. Không có ký tự đặc biệt - Đã làm được
. Không trùng lặp: Tính nay này tôi chưa làm được. Nhờ các bác giúp đỡ chỉnh lại

Xin đa tạ

Góp ý thôi chứ không có thời gian làm:
1/ Không ghi từng cell như vậy, bạn thử đổi thành 1000 kết quả là thấy tốc độ chậm thế nào
2/ Để không trùng, đơn giản nhất là add vào dictionary, add lỗi thì tức là key đã có

 

[snow25]

Chào các bác

File đính kèm là tôi dùng để tạo 1 dãy ký tự ngẫu nhiên:
. Độ dài ký tự: Tự thiết lập - Đã làm được
. Số lượng dãy ký tự: Tự thiết lập - Đã làm được
. Viết hoa - Đã làm được
. Bao gồm ký tự số(0 - 9) & chữ cái(Không bao gồm chữ O) - Đã làm được
. Không có ký tự đặc biệt - Đã làm được
. Không trùng lặp: Tính nay này tôi chưa làm được. Nhờ các bác giúp đỡ chỉnh lại

Xin đa tạ

Chỉnh sửa 1 chút code của bạn không bẫy lỗi khi kết quả không đủ.

Sub Random()
    Dim output As String
    Dim length As Integer
    Dim noResult As Long
    Dim x As Long, dic As Object, s As String
    Set dic = CreateObject("scripting.dictionary")
    
    length = ActiveSheet.Range("B1").Value
    noResult = ActiveSheet.Range("B2").Value
      Range("B4:B1000").ClearContents
    Do
        s = RandString(length)
        If Not dic.exists(s) Then
            x = x + 1
            Range("B" & x + 3).Value = s
        End If
        If x = noResult Then Exit Do
    Loop
    Set dic = Nothing
End Sub

 

[bebo021999]

Không trùng giữa các ký tự trong 1 ô, hay là giữa các ô với nhau?
VD: "ABACD" (trùng chữ "A") gọi là trùng trong 1 ô
hay
"ABCDE" ô 1 và "ABCDE" tại ô 2 gọi là trùng giữa các ô
hay cả 2 trường hợp này là trùng và không thỏa điều kiện?

 

[Phuocam]

.

Code cần phải bẫy lỗi, ví dụ nhập 1 vào B1 và 50 vào B2 => code chạy hoài không nghỉ.

.

 

[tsslump]

Không trùng giữa các ký tự trong 1 ô, hay là giữa các ô với nhau?
VD: "ABACD" (trùng chữ "A") gọi là trùng trong 1 ô
hay
"ABCDE" ô 1 và "ABCDE" tại ô 2 gọi là trùng giữa các ô
hay cả 2 trường hợp này là trùng và không thỏa điều kiện?

Cái dãy ký tự không trùng nhau bạn nhé, còn trùng nhau trong 1 chuỗi ký tự thì vô tư

Bài đã được tự động gộp: 15/9/22

Chỉnh sửa 1 chút code của bạn không bẫy lỗi khi kết quả không đủ.

Sub Random()
    Dim output As String
    Dim length As Integer
    Dim noResult As Long
    Dim x As Long, dic As Object, s As String
    Set dic = CreateObject("scripting.dictionary")
   
    length = ActiveSheet.Range("B1").Value
    noResult = ActiveSheet.Range("B2").Value
      Range("B4:B1000").ClearContents
    Do
        s = RandString(length)
        If Not dic.exists(s) Then
            x = x + 1
            Range("B" & x + 3).Value = s
        End If
        If x = noResult Then Exit Do
    Loop
    Set dic = Nothing
End Sub

Cảm ơn bác nhưng vẫn bị trùng nhau bác nhé

 

[snow25]

Cái dãy ký tự không trùng nhau bạn nhé, còn trùng nhau trong 1 chuỗi ký tự thì vô tư

Bài đã được tự động gộp: 15/9/22

Cảm ơn bác nhưng vẫn bị trùng nhau bác nhé

Vậy sửa thêm cái này nữa.

Function RandString(n As Integer) As String
    'Assumes that Randomize has been invoked by caller
    Dim i As Integer, j As Integer, m As Integer, s As String, pool As String, dieukien(1 To 35) As Boolean
    pool = "0123456789ABCDEFGHIJKLMNPQRSTUVWXYZ"
    m = Len(pool)
    Do
        j = 1 + fix(m * Rnd())
        If dieukien(j) = False Then
            s = s & Mid(pool, j, 1)
            dieukien(j) = True
            i = i + 1
            If i = n Then Exit Do
        End If
    Loop
    RandString = s
End Function

 

[SA_DQ]

Option Explicit
Const Alf As String = "AB0CD1EF2GH3IJ4KL5MN6PQ7RS8TU9VWXYZ"

Sub TaoChuoiNgau()
 Dim SoLg As Integer, DDai As Integer, J As Long, Gia As Integer
 Dim StrC As String

 DDai = [B1].Value:             SoLg = [B2].Value
 ReDim Arr(1 To SoLg, 1 To 1) As String:        Gia=1
 Do
    StrC = StrC & Alf
    If Len(StrC) > DDai * (2 + SoLg) Then Exit Do
 Loop
 If Len(Alf) / DDai = Len(Alf) \ DDai Then Gia = 2
 For J = 1 To SoLg
    Arr(J, 1) = Mid(StrC, 1, DDai)
    StrC = Mid(StrC, DDai + Gia, Len(StrC))
 Next J
 [D2].Resize(SoLg).Value = Arr()
End Sub

 

[bebo021999]

Mình thấy có 1 sub và tới 2 function để thực hiện 1 công việc mà vẫn bị trùng lắp quả hơi phí
Theo mình chỉ cần 1 sub và 2 vòng lặp Do...Loop + 1 dic để kiểm ra trùng lắp là đủ:

Option Explicit
Sub test()
Dim i&, j&, r&
Dim dic As Object
Dim pool As String, st As String
Set dic = CreateObject("Scripting.Dictionary")
pool = "0123456789ABCDEFGHIJKLMNPQRSTUVWXYZ"
Randomize
Do While i < Range("B2").Value
    st = "": j = 0
    Do While j < Range("B1").Value
        j = j + 1
        r = Int(Rnd * Len(pool)) + 1
        st = st & Mid(pool, r, 1)
    Loop
    If Not dic.exists(st) Then
        i = i + 1
        dic.Add st, i
    End If
Loop
Range("B4").Resize(dic.Count, 1).Value = WorksheetFunction.Transpose(dic.keys)
End Sub

 

[Nhattanktnn]

Cái dãy ký tự không trùng nhau bạn nhé, còn trùng nhau trong 1 chuỗi ký tự thì vô tư

Bài đã được tự động gộp: 15/9/22

Cảm ơn bác nhưng vẫn bị trùng nhau bác nhé

Bác ấy thiếu khúc add key
Thử code bên dưới nhé:

Private Const Pool = "0123456789ABCDEFGHIJKLMNPQRSTUVWXYZ"
Sub Random()
    Dim length&, noResult&, iMax&, X&, Dic As Object, S$
    Set Dic = CreateObject("scripting.dictionary")
    length = ActiveSheet.Range("B1").Value
    noResult = ActiveSheet.Range("B2").Value
    iMax = Len(Pool) ^ length
    Range("B4:B10000").ClearContents
    Do
        S = RandString(length)
        If Not Dic.exists(S) Then
            Dic.Add S, ""
            X = X + 1
        End If
        If X = iMax Then Exit Do
    Loop Until X = noResult
    Range("B4").Resize(X) = Application.Transpose(Dic.keys)
    Set Dic = Nothing
End Sub

Function RandString$(ByVal n&)
    'Assumes that Randomize has been invoked by caller
    Dim i&, j&, m&, S$
    m = Len(Pool)
    For i = 1 To n
        j = 1 + Int(m * Rnd())
        S = S & Mid(Pool, j, 1)
    Next i
    RandString = S
End Function

 

[VetMini]

Bác ấy thiếu khúc add key
Thử code bên dưới nhé:

Private Const Pool = "0123456789ABCDEFGHIJKLMNPQRSTUVWXYZ"
....

Nên tránh dùng biến toàn cục. Chỉ sử dụng khi RẤT tiện lợi.
Trong trường hợp này, nếu sub mẹ chuyển cái string cho function con thì chỉ tốn thì giờ chút xíu (vài phần triệu giây) nhưng được cái lợi là code uyển chuyển hơn. Lúc sub mẹ cần đổi dạng string thì cứ tự tiện.

Sub ME()
Const POOL = "0123456789ABCDEFGHIJKLMNPQRSTUVWXYZ"
' tôi chẳng hiểu sao trừ đi O để tránh nhầm với 0 mà không trừ I để tránh nhầm với 1
...
Do While Dic.Count < soLuongMa
Dic(LayMa(POOL, soKyTu)) = ""
Loop
...
End Sub

Function LayMa(chuoi As String, skt As Long) As String
' gets a string of skt characters randomly from the pool chuoi
Dim i As Long, ln As Long
ln = Len(chuoi)
LayMa = Space(skt)
For i = 1 To skt
Mid(LayMa, i, 1) = Mid(chuoi, 1 + Int(ln* Rnd()), 1)
Next i
End Function