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
Altın Üyelik Bitiş Tarihi
13-04-2027
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,
 
kulomer46

kulomer46

Altın Üye
Katılım
23 Mart 2007
Mesajlar
1,513
Excel Vers. ve Dili
Microsoft Office LTSC Professional Plus 2021 - Türkçe
Altın Üyelik Bitiş Tarihi
08-06-2027
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
 
cimcoz

cimcoz

Altın Üye
Katılım
6 Ekim 2004
Mesajlar
324
Excel Vers. ve Dili
MS Office Plus 2016 & Mac OSX
Altın Üyelik Bitiş Tarihi
13-04-2027
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..
 
cimcoz

cimcoz

Altın Üye
Katılım
6 Ekim 2004
Mesajlar
324
Excel Vers. ve Dili
MS Office Plus 2016 & Mac OSX
Altın Üyelik Bitiş Tarihi
13-04-2027
kulomer46

kulomer46

Altın Üye
Katılım
23 Mart 2007
Mesajlar
1,513
Excel Vers. ve Dili
Microsoft Office LTSC Professional Plus 2021 - Türkçe
Altın Üyelik Bitiş Tarihi
08-06-2027
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
 
cimcoz

cimcoz

Altın Üye
Katılım
6 Ekim 2004
Mesajlar
324
Excel Vers. ve Dili
MS Office Plus 2016 & Mac OSX
Altın Üyelik Bitiş Tarihi
13-04-2027
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..
 
P

PLİNT

Katılım
31 Aralık 2014
Mesajlar
1,845
Excel Vers. ve Dili
Excel 2010
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
 
cimcoz

cimcoz

Altın Üye
Katılım
6 Ekim 2004
Mesajlar
324
Excel Vers. ve Dili
MS Office Plus 2016 & Mac OSX
Altın Üyelik Bitiş Tarihi
13-04-2027
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.
Üst