- Katılım
- 6 Kasım 2005
- Mesajlar
- 300
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Merhaba,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...
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
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.syn leumruk, konu çözüldü...tşk.ler...bir ricam daha var, bunun aynısını harfli yapabilirmiyiz...
Ekteki örneği inceleyin. B1 hücresine kaç adet rakam üretmesini istiyorsanız yazın.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
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
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.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...
Merhaba,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,syn leumruk ilginize teşekkür ediyorum...dosya ektedir...