• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Rastgele karakter oluşturma

  • Konbuyu başlatan Konbuyu başlatan k0081
  • Başlangıç tarihi Başlangıç tarihi
Katılım
17 Haziran 2008
Mesajlar
1,874
Excel Vers. ve Dili
Microsoft Ofis Profesyonel 2019 x64 TR
Merhaba arkadaşlar;

Textbox1 45 yazdığımda akabinde tamam butonuna bastığımda, textbox2 ye 45 karakterli rastgele bir harf serisini nasıl oluşturabilirim.?


yardımcı arkadaşa şimdiden teşekkürler.
 
Private Sub CommandButton1_Click()
Dim a
TextBox2.Text = ""
For a = 1 To TextBox1.Text
TextBox2.Text = TextBox2.Text + Chr$(Int((26 * Rnd) + 65))
Next a
End Sub
 
mgurten & ExcelF1

çok teşekkürler arkadaşlar, Tamamdır..
 
mgurten & ExcelF1

çok teşekkürler arkadaşlar, Tamamdır..
Private Sub CommandButton1_Click()
Dim a
TextBox2.Text = ""
For a = 1 To TextBox1.Text
TextBox2.Text = TextBox2.Text + Chr$(Int((26 * Rnd) + 65))
Next a
End Sub

bu kodu kullandığımda bazen aynı karakterler denk gelebiliyor.,,,

Aynı karakterlerin denk gelmemesi için kodu nasıl değiştirmeliyiz ?

Not : Sayılarda olabilir. Sayılar denk gelirse bu sefer büyük/küçük harf ile atlatılabilir.
 
Aynı karakterler peş peşe mi gelmeyecek yoksa hiç mi yer almayacak?
 
bazen aynı karakterler denk gelebiliyor.,,,

Aynı karakterlerin denk gelmemesi için kodu nasıl değiştirmeliyiz ?

Not : Sayılarda olabilir. Sayılar denk gelirse bu sefer büyük/küçük harf ile atlatılabilir.
Kod:
Function rastgeleUret(Optional uzunluk = 1)

    ptrn = "0123456789AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz"
    uz = Len(ptrn)
    If uzunluk > uz Then uzunluk = uz
    For i = 1 To uz
        ii = WorksheetFunction.RandBetween(1, uz)
        a1 = Mid(ptrn, i, 1)
        a2 = Mid(ptrn, ii, 1)
        ptrn = Replace(ptrn, a1, ".")
        ptrn = Replace(ptrn, a2, a1)
        ptrn = Replace(ptrn, ".", a2)
    Next i
    bas = WorksheetFunction.RandBetween(1, uz - uzunluk + 1)
    rastgeleUret = Mid(ptrn, bas, uzunluk)

End Function
Fonksiyonu modüle ekleyip, aşağıdaki gibi kullanabilirsiniz.
Kod:
Private Sub CommandButton1_Click()
    TextBox2.Text = rastgeleUret(CInt(TextBox1.Text))
End Sub
 
Aşağıdaki kodları deneyiniz, karakteri isteğinize göre düzenleyebilirsiniz. Tekrar olmayacağı için textbox1'e en fazla karakter sayısı kadar sayı girebilirsiniz.
PHP:
Private Sub CommandButton1_Click()
Dim a As Byte, k As String
krk = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", _
            "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", _
            "a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z")
TextBox2.Text = ""
If TextBox1.Value > UBound(krk) + 1 Then
    MsgBox "En fazla " & UBound(krk) + 1 & " değer girebilirsiniz.", vbCritical
    Exit Sub
End If
Randomize
For a = 1 To TextBox1.Value
    k = krk(Int((UBound(krk) + 1) * Rnd))
    If InStr(1, TextBox2.Text, k) = 0 Then
        TextBox2.Text = TextBox2.Text + k
    Else
        a = a - 1
    End If
Next a
End Sub
 
Veysel emre;

Hesap yaptırmadım, Belki abartmış da olabilirim.

Şimdi şöyle bir örnek verelim;

Şu anda 62 karakter göre işlem var.
bu 62 karakerin her birinin üzerine ² simgesini ekleyelim : 62+62 = 124 yapar.
bu 62 karakerin her birinin üzerine ³ simgesini ekleyelim : 124+62 = 186 yapar.
bu 62 karakerin her birinin üzerine ¹ simgesini ekleyelim : 186+62 = 248yapar.

bu 62 karakerin her birinin üzerine ° simgesini ekleyelim : 248+62 = 310 yapar.
bu 62 karakerin her birinin üzerine ½ simgesini ekleyelim : 310+62 = 372 yapar.
bu 62 karakerin her birinin üzerine ® simgesini ekleyelim : 372+62 = 434 yapar.
bu 62 karakerin her birinin üzerine © simgesini ekleyelim : 434+62 = 496 yapar.
....
...
http://s2.dosya.tc/server7/gmy8uc/hesap.jpg.html

yani böyle devam edebilir... her harfin yanına bir sembol eklenip yeni bir karakter oluşturulmuş olur. Saygılarımla.
 
ÖmerBey

Hocam çok teşekkürler, Tamamdır. elinize sağlık.
 
veyselemre;


Hocam çok teşekkürler, Tamamdır. elinize sağlık.
 
Rica ederim, ama sizin 14 numaralı mesajdaki örneğe göre tamam olmaz bilginiz olsun da...
İyi çalışmalar.

Evet sizin kod üzerinde denedim, olmuyor... çalışmıyor...
 
Son düzenleme:
Geri
Üst