• DİKKAT

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

Rastgele Harf Üretme

cimcoz

cimcoz

Altın Üye
Katılım
6 Ekim 2004
Mesajlar
324
Excel Vers. ve Dili
MS Office Plus 2016 & Mac OSX
Merhabalar,

Bir hücre içine A,B,C,D,E,F,G,H,I harflerinden herhangi birini rasgele olarak getirmek istiyorum. Aynı satırdaki farklı hücrelere bu 9 harften herhangi birini rastgele getirebilen bir makroya ihtiyacım var. Gelecek harfler mükerrer olabilir.
Yani;
1. Satır : A,B,C,D,A,B,H,E,J
2. Satır : G,F,B,D,I,B,H,C,C
3.
.
Makroya basılınca rastgele en az 10 satıra farklı harfler gelebilirse sevinirim.

Yardımlarınız için şimdiden teşekkür ederim.

Saygılarımla,
 
Makroya basılınca rastgele 10 satıra mükerrer yada farklı harfler gelmektedir..

Selamlar...

Kod: 
Sub rastgele()

Randomize Timer

For i = 1 To 10
    For j = 1 To 9
  
        rastgele = Int(Rnd * 9) + 1
      
        Select Case rastgele
      
        Case 1: Cells(i, j) = "A"
        Case 2: Cells(i, j) = "B"
        Case 3: Cells(i, j) = "C"
        Case 4: Cells(i, j) = "D"
        Case 5: Cells(i, j) = "E"
        Case 6: Cells(i, j) = "F"
        Case 7: Cells(i, j) = "G"
        Case 8: Cells(i, j) = "H"
        Case 9: Cells(i, j) = "I"
      
        End Select
      
    Next
Next


End Sub
 
kulomer46' Alıntı:
Makroya basılınca rastgele 10 satıra mükerrer yada farklı harfler gelmektedir..

Selamlar...

Kod: 
Sub rastgele()

Randomize Timer

For i = 1 To 10
    For j = 1 To 9
 
        rastgele = Int(Rnd * 9) + 1
     
        Select Case rastgele
     
        Case 1: Cells(i, j) = "A"
        Case 2: Cells(i, j) = "B"
        Case 3: Cells(i, j) = "C"
        Case 4: Cells(i, j) = "D"
        Case 5: Cells(i, j) = "E"
        Case 6: Cells(i, j) = "F"
        Case 7: Cells(i, j) = "G"
        Case 8: Cells(i, j) = "H"
        Case 9: Cells(i, j) = "I"
     
        End Select
     
    Next
Next


End Sub
Genişletmek için tıkla ...


Çok teşekkürler tam istediğim gibi oldu. Ellerinize sağlık.

Saygılarımla..
 
Aşağıdaki Rastgele_Dağıt makrosu çalışmaya B2'den başlamaktadır. Çünkü A sütunu ve 1. satıra başlıklar eklenmesi gerekebilir. Selamlar...

Kod: 
Sub Rastgele_Dağıt()

Randomize Timer

For i = 2 To 11
    For j = 2 To 10
    
        rastgele = Int(Rnd * 9) + 1
        
        Select Case rastgele
        
        Case 1: Cells(i, j) = "A"
        Case 2: Cells(i, j) = "B"
        Case 3: Cells(i, j) = "C"
        Case 4: Cells(i, j) = "D"
        Case 5: Cells(i, j) = "E"
        Case 6: Cells(i, j) = "F"
        Case 7: Cells(i, j) = "G"
        Case 8: Cells(i, j) = "H"
        Case 9: Cells(i, j) = "I"
        
        End Select
        
    Next
Next


End Sub
 
kulomer46' Alıntı:
Aşağıdaki Rastgele_Dağıt makrosu çalışmaya B2'den başlamaktadır. Çünkü A sütunu ve 1. satıra başlıklar eklenmesi gerekebilir. Selamlar...

Kod: 
Sub Rastgele_Dağıt()

Randomize Timer

For i = 2 To 11
    For j = 2 To 10
   
        rastgele = Int(Rnd * 9) + 1
       
        Select Case rastgele
       
        Case 1: Cells(i, j) = "A"
        Case 2: Cells(i, j) = "B"
        Case 3: Cells(i, j) = "C"
        Case 4: Cells(i, j) = "D"
        Case 5: Cells(i, j) = "E"
        Case 6: Cells(i, j) = "F"
        Case 7: Cells(i, j) = "G"
        Case 8: Cells(i, j) = "H"
        Case 9: Cells(i, j) = "I"
       
        End Select
       
    Next
Next


End Sub
Genişletmek için tıkla ...


Süper oldu şimdi. Çok teşekkür ederim. Ellerinize sağlık.

Saygılarımla..
 
cimcoz' Alıntı:
Merhaba,
Ekli dosya çalışmadı maalesef. Macro mevcut değil ve sayfa boş çıkıyor.

Teşekkürler.
Genişletmek için tıkla ...
Merhaba
Kodlar "sayfa1" kod penceresinde idi
https://hizliresim.com/XM84NR

Kod: 
Private Sub CommandButton1_Click()
Dim data As Variant

e = Array("A", "B", "C", "D", "E", "F", "G", "H", "I")
For t = 1 To 10
data = UniqueRandomNumbers(9, 1, 9)
Cells(t, 1) = e(data(1) - 1) & "," & e(data(2) - 1) & "," & e(data(3) - 1) & "," & e(data(4) - 1) & "," & _
e(data(5) - 1) & "," & e(data(6) - 1) & "," & e(data(7) - 1) & "," & e(data(8) - 1) & "," & e(data(9) - 1)

Next
End Sub

Function UniqueRandomNumbers(NumCount As Long, LLimit As Long, ULimit As Long) As Variant

Dim RandColl As Collection, i As Long, varTemp() As Long
UniqueRandomNumbers = False

If NumCount < 1 Then Exit Function
If LLimit > ULimit Then Exit Function
If NumCount > (ULimit - LLimit + 1) Then Exit Function
Set RandColl = New Collection
Randomize
Do
On Error Resume Next
i = CLng(Rnd * (ULimit - LLimit) + LLimit)
RandColl.Add i, CStr(i)
On Error GoTo 0
Loop Until RandColl.Count = NumCount

ReDim varTemp(1 To NumCount)

For i = 1 To NumCount
varTemp(i) = RandColl(i)
Next i

Set RandColl = Nothing
UniqueRandomNumbers = varTemp
Erase varTemp
End Function
 
PLİNT' Alıntı:
Merhaba
Kodlar "sayfa1" kod penceresinde idi
https://hizliresim.com/XM84NR

Kod: 
Private Sub CommandButton1_Click()
Dim data As Variant

e = Array("A", "B", "C", "D", "E", "F", "G", "H", "I")
For t = 1 To 10
data = UniqueRandomNumbers(9, 1, 9)
Cells(t, 1) = e(data(1) - 1) & "," & e(data(2) - 1) & "," & e(data(3) - 1) & "," & e(data(4) - 1) & "," & _
e(data(5) - 1) & "," & e(data(6) - 1) & "," & e(data(7) - 1) & "," & e(data(8) - 1) & "," & e(data(9) - 1)

Next
End Sub

Function UniqueRandomNumbers(NumCount As Long, LLimit As Long, ULimit As Long) As Variant

Dim RandColl As Collection, i As Long, varTemp() As Long
UniqueRandomNumbers = False

If NumCount < 1 Then Exit Function
If LLimit > ULimit Then Exit Function
If NumCount > (ULimit - LLimit + 1) Then Exit Function
Set RandColl = New Collection
Randomize
Do
On Error Resume Next
i = CLng(Rnd * (ULimit - LLimit) + LLimit)
RandColl.Add i, CStr(i)
On Error GoTo 0
Loop Until RandColl.Count = NumCount

ReDim varTemp(1 To NumCount)

For i = 1 To NumCount
varTemp(i) = RandColl(i)
Next i

Set RandColl = Nothing
UniqueRandomNumbers = varTemp
Erase varTemp
End Function
Genişletmek için tıkla ...


Merhaba,

Zahmet edip ekran görüntüsü almışsınız. Vaktinizi aldım teşekkür ederim.
Button'a basınca bu hata çıkıyor;

Alert
Cannot run the macro 'deneme.xlsm!CommandButton1_Click'.
The macro may not be available in this workbook or all macros may be disabled.

Makrolar açık durumda Office 2016 (macbook) kullanıyorum belki o yüzden olabilir.
İlginiz için çok teşekkür ederim.

Saygılar,
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst