• DİKKAT

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

otomatik sayı üretme

Selam,

Lütfen sorunuzu daha detaylı izah edin, anlaşılmadı.
 
11 sayılık bir rakam ise örneğin baştan 00524 yazmış isem diğer kalan rakamları kendisinin otomatik olarak üretmesini istiyorum...yada beşinci rakamın 5 sonuncu rakamın 8 olmasını istiyorsam aradaki rakamları kaç değişik biçimde olacak şekilde aşağıya doğru sıralamasını istiyorum...
 
Basit ama ise yarar karisik sayi uretme. Umarim isine yarar. Dosya ektedir.
 

Ekli dosyalar

11 sayılık bir rakam ise örneğin baştan 00524 yazmış isem diğer kalan rakamları kendisinin otomatik olarak üretmesini istiyorum...yada beşinci rakamın 5 sonuncu rakamın 8 olmasını istiyorsam aradaki rakamları kaç değişik biçimde olacak şekilde aşağıya doğru sıralamasını istiyorum...
Merhaba,
Aşağıdaki örneği inceleyin.
Kod:
Sub Sayi_Üret()
If Not IsNumeric([a1].Text) Then
MsgBox "Hücreye sayısal bir değer giriniz.", vbCritical, "UYARI"
Exit Sub: End If
Randomize
[a5:k65536].ClearContents
For x = 1 To [a1].Text
    For y = 1 To 11
        If Cells(3, y) <> "" Then
            Cells(x + 4, y) = Cells(3, y)
        Else
        sayi = Int((10 * Rnd))
            Cells(x + 4, y) = sayi
        End If
    Next
Next
End Sub
 

Ekli dosyalar

syn leumruk çok güzel olmuş eline sağlık...yalnız 11 rakamını rakamların sayı adedini belirtmek için yazmıştım...oraya 3 yazdığımda 3 kombinasyonu biçiminde örneğin 456-465 gibi...4 yazdığımda ise 4 rakamdan oluşan otamatik sayı üretmesini istemiştim...dolayısıyla bunu dikkate alarak yeniden gözden geçirebilirmisiniz...yani 11 sınırlması rakam adedini belirtmek için, sayı üretmede bir kısıtlama olmasın...
 
syn leumruk çok güzel olmuş eline sağlık...yalnız 11 rakamını rakamların sayı adedini belirtmek için yazmıştım...oraya 3 yazdığımda 3 kombinasyonu biçiminde örneğin 456-465 gibi...4 yazdığımda ise 4 rakamdan oluşan otamatik sayı üretmesini istemiştim...dolayısıyla bunu dikkate alarak yeniden gözden geçirebilirmisiniz...yani 11 sınırlması rakam adedini belirtmek için, sayı üretmede bir kısıtlama olmasın...
 
syn leumruk, konu çözüldü...tşk.ler...bir ricam daha var, bunun aynısını harfli yapabilirmiyiz...
 
syn leumruk, konu çözüldü...tşk.ler...bir ricam daha var, bunun aynısını harfli yapabilirmiyiz...
Harfli ile kastettiğinizi anlayamadım. Biraz açıklama yapabilir misiniz? Eğer Sayı yerine harf üretmesini istiyorsanız; bu isteğiniz yapılabilir. Ancak bir örnek dosya ile ne tür kriterler istediğinizi belirtmelisiniz.
 
evet sayı yyerine harf üretmek istiyorum...tabi örneğim diyelimki 5 harfli bir kelime baş harfi A SON harfi K olan tüm cümleleri sıralalaması daha iyi olur...yardımlarınız için şimdiden tşk.ler...kolay gelsin
 
evet sayı yyerine harf üretmek istiyorum...tabi örneğim diyelimki 5 harfli bir kelime baş harfi A SON harfi K olan tüm cümleleri sıralalaması daha iyi olur...yardımlarınız için şimdiden tşk.ler...kolay gelsin
Ekteki örneği inceleyin. B1 hücresine kaç adet rakam üretmesini istiyorsanız yazın.
Kod:
Sub Sayi_Üret()
Dim kelime As Variant
Hrf = Array("A", "B", "C", "Ç", "D", "E", "F", "G", "Ğ", "H", "I", "İ", "J", "K", "L", "M", "N", "O", "Ö", "P", "R", "S", "Ş", "T", "U", "Ü", "V", "Y", "Z")
If Not IsNumeric([a1].Text) Or Not IsNumeric([b1].Text) Then
MsgBox "a1 ve b1 hücrelerinde sayısal bir değer buluması gerekli.", vbCritical, "UYARI"
Exit Sub: End If
Randomize
[a5:z65536].ClearContents
For x = 1 To [a1].Text
    For y = 1 To [b1].Text
        If Cells(3, y) <> "" Then
            Cells(x + 4, y) = Cells(3, y)
            kelime = kelime & Cells(3, y)
        Else
        sayi = Int((UBound(Hrf) * Rnd))
            Cells(x + 4, y) = Hrf(sayi)
            kelime = kelime & Hrf(sayi)
        End If
    Next
    Cells(x + 4, y + 2) = kelime
    If Not Sheets("Sayfa2").Cells.Find(kelime, lookat:=xlWhole, LookIn:=xlValues) Is Nothing _
    And Sheets("Sayfa3").Cells.Find(kelime, lookat:=xlWhole, LookIn:=xlValues) Is Nothing Then
    MsgBox "Daha önce kaydedilmemiş anlamlı kelime bulundu. Sayfa3'e aktarılacak." & Chr(10) & "___________________" & Chr(10) & kelime, vbInformation, "DURUM"
    Sat = Sheets("Sayfa3").[a65536].End(3).Row + 1
    Sheets("Sayfa3").Cells(Sat, "a") = kelime
    Application.CutCopyMode = False
    End If
    kelime = ""
Next
End Sub
 

Ekli dosyalar

Son düzenleme:
syn leumruk çok süper olmuş...ellerine sağlık...acizane bir şey daha sorayım...bunun içerisinde geçen anlamlı cümleleri farklı renkte yapabilirmiyiz...tşk.ler leumruk...
 
syn leumruk çok süper olmuş...ellerine sağlık...acizane bir şey daha sorayım...bunun içerisinde geçen anlamlı cümleleri farklı renkte yapabilirmiyiz...tşk.ler leumruk...
Anlamlı kelimeyi bilgisayarın tanımasını sağlayamayız. Bir çözümü var, o da oldukça zahmetli olur. Anlamlı kelimeleri ayrı bir sayfada satırlara tek tek girebilirseniz, buradan kontrolünü yaptırabiliriz. Kısaca türkçedeki tüm sözcükleri başka bir sayfaya yazmalısınız.
 
sayfa2 ye bu kelimeleri attık...ona göre anlamlı keimeleri sayfa1 in her hangi bir sutununa yada sayfa3 e atabilirmiyiz...bu konuda da yardımlarını esirgemezsen sevinirim....şimdiden tşk.ler
 
sayfa2 ye bu kelimeleri attık...ona göre anlamlı keimeleri sayfa1 in her hangi bir sutununa yada sayfa3 e atabilirmiyiz...bu konuda da yardımlarını esirgemezsen sevinirim....şimdiden tşk.ler
Merhaba,
Yapılabilir. Yapmak istediğiniz konusunda ayrıntılı bilgi verebilirseniz, bu kolaylık sağlayacaktır. Ne yapacağımızı bilirsek ona göre alternatifler, çözümler üretebiliriz.
 
syn leumruk eline sağlık çok güzel olmuş...bir ricam daha olacak mükerrer olanları engelleyebilirmiyiz...örneğin ÜRET dediğimizde mükerrer olarak 5 tane ARABA çıkabiliyor...
 
Merhaba,
12 nolu mesajdaki dosyayı güncelledim. Kontrolü sayfa3'e göre yapıyor. Eğer Sayfa3'te varsa aktarmıyor; yoksa mesaj verip aktarımı gerçekleştiriyor. Kayıt işlemi Sayfa3'ün A sütununa yapılıyor.
 
Geri
Üst